Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Sub Generation_Click() a = CodeBarreCode39(NoCB.Text, 2700, 700, 800, 2000) Printer.EndDoc End Sub '==============================CodeBarreCode39======================================' 'Cette méthode crée le code binaire en code 39 du code barre pCodeBar. Elle l'envoie' 'à la méthode ImpCodeBarre qui imprime le code barre. Ensuite elle imprime le numéro' 'de code barre en dessous. La taille de la police est modifiée en fonction de la ' 'taille du code barre. ' ' ' 'Param : - pCodeBar : code barre à imprimer ' ' - Col,Lig : Position d'impression ' ' - Hauteur : Hauteur du code barre ' ' - Largeur : Largeur du code barre (Si le code barre est illisible, il faut ' ' augmenter cette largeur) ex : pour la Smart Label Printer, la ' ' largeur minimale vaut 1750 en dessous, le CB est illisible ' ' ' '==================================================================================='Public Function CodeBarreCode39(pCodeBar As String, Col As Long, Lig As Long, Optional Hauteur As Long 800, Optional largeur As Long 1500) Dim TJA(10) As String Dim CodeBar As String Dim Chiffre As Long Dim Ind As Long Dim CodeChiffre As String ' Profil binaire des traits Dim Lettre As String ' Dim Epaisseur1Trait As Double ' Epaisseur d'un trait Dim Decalage As Long CodeBar = pCodeBar ' initialisation du jeu de caractères pour code barre Code 39 ' Le TJA(10) correspond au caractère de début et de fin du code barre (caractère *) TJA(0) = "0001101000" TJA(1) = "1001000010" TJA(2) = "0011000010" TJA(3) = "1011000000" TJA(4) = "0001100010" TJA(5) = "1001100000" TJA(6) = "0011100000" TJA(7) = "0001001010" TJA(8) = "1001001000" TJA(9) = "0011001000" TJA(10) = "0100101000" '//==== Creation du mask représentant le code barre (série de 1, de 0) '//"0" une bande étroite '//"1" une bande large '//"-" diminution de la hauteur du code barre (pour mettre le texte en dessous) '//"+" Augmentation de la hauteur du code barre CodeChiffre = TJA(10) + "-" For Ind = 1 To Len(CodeBar) Chiffre = Val(Mid(CodeBar, Ind, 1)) CodeChiffre = CodeChiffre + TJA(Chiffre) Next Ind '============== GUARD PATTERN CodeChiffre = CodeChiffre + "+" + TJA(10) '==== Impression du mask sous forme de code barre Decalage = 30 Epaisseur1Trait = ImpCodeBarre(Lig, Col, Hauteur, largeur, CodeChiffre, Decalage) '==== Impression du code serie en dessous du code barre ' Crée une police de taille proportionnelle à la largeur de code barre Debug.Print "FontSize = " & Printer.FontSize Dim FontSizeCB As Integer FontSizeCB = Fix(0.8 * Epaisseur1Trait) Debug.Print "FontSize = " & FontSize Debug.Print "ScaleMode = " & Printer.ScaleMode Printer.CurrentX = (Col + 13 * Epaisseur1Trait) Printer.CurrentY = (Lig + Hauteur + 10 - Decalage) Printer.FontName = "Arial" Printer.FontSize = FontSizeCB Dim CodeBar1 As String ' CodeBar1 est le numéro de code barre avec un espace entre chaque caractère CodeBar1 = "" For i = 1 To Len(CodeBar) - 1 essai = Mid(CodeBar, i, 1) CodeBar1 = CodeBar1 & essai & " " Next i essai = Mid(CodeBar, Len(CodeBar), 1) CodeBar1 = CodeBar1 & essai Printer.Print (CodeBar1) End Function '=============================ImpCodeBarre==========================================' 'Cette méthode imprime le code barre code 39 converti en binaire. ' ' ' 'Param : - Lig, Col : La position du code barre ' ' - nHauteur, nLargeur : La taille du code barre ' ' - szCodeBarre : Le code barre converti en binaire code 39 ' ' - Decalage : La quantité à soustraire à nHauteur lorsqu'il y a un "-" dans ' ' szCodeBarre ou à ajouter s'il y a un "+" ' ' ' 'Return : la largeur d'un trait élémentaire ' ' ' '===================================================================================' Private Function ImpCodeBarre(Lig As Long, Col As Long, nHauteur As Long, nLargeur As Long, szCodeBarre As String, Optional Decalage As Long) Dim NumCar As Long Dim NbTrait As Long Dim BarreCourte As Double ' Epaisseur d'un trait élémentaire Dim BarreLarge As Double Dim j As Long Dim X As Double Dim nLen As Long Dim NCarac As Long Dim Hauteur As Long Dim Barre As Boolean Dim nBarresNoires As Double Dim nBarresBlanches As Double nBarresNoires = 0 nBarresBlanches = 0 Barre = True ' si Barre vaut True c'est une barre qu'il faut imprimer ' sinon c'est un espace nLen = 0 For i = 1 To Len(szCodeBarre) If Mid(szCodeBarre, i, 1) <> "-" Or Mid(szCodeBarre, i, 1) <> "+" Then Select Case Mid(szCodeBarre, i, 1) Case "1" If Barre = True Then nBarresNoires = nBarresNoires + 2 Barre = False Else nBarresBlanches = nBarresBlanches + 1.5 Barre = True End If Case "0" If Barre = True Then nBarresNoires = nBarresNoires + 1 Barre = False Else nBarresBlanches = nBarresBlanches + 1 Barre = True End If End Select nLen = nLen + 1 ' Nombre de barres et espaces à analyser End If Next i NCarac = nLen / 9 ' Calcul de l'épaisseur d'un trait suivant la largeur demandée et le nombre de traits BarreCourte = nLargeur / (nBarresNoires + nBarresBlanches) BarreLarge = BarreCourte * 1.5 ' Un caractère est codé par 16 barres élémentaires (BE) ' (3 grandes de 1.5 BE et 6 petites de 1 BE) ' Il faut aussi ajouter une BE d'espacement BarreCourteBlanche = BarreCourte * 1.5 BarreLargeBlanche = BarreCourteBlanche * 1.5 BarreCourteNoire = BarreCourte * (1 - 0.5 * nBarresBlanches / nBarresNoires) BarreLargeNoire = BarreCourteNoire * 2 'Il faut distiguer la largeur des bandes noires de la largeur des bandes blanches 'pour que l'impression des étiquettes se fasse correctement. En effet, l'imprimant 'Smart Label Printer imprime les bandes blanches de taille inférieure aux bandes noires ' 'Si cela vous gène utilisez BarreCourte à la place de BarreCourteBlanche et BarreCourteNoire 'et BarreLarge à la place de BarreLargeBlanche et BarreLargeNoire 'Dans ce cas là, il faudra aussi modifier le calcul du nombre de barres : ' Dans le For i = 1 To Len(szCodeBarre) remplacez : ' - nBarresNoires = nBarresNoires + 2 ' Par : ' - nBarresNoires = nBarresNoires + 1.5 Hauteur = nHauteur NumCar = 1 Do While NumCar <= nLen Select Case Mid(szCodeBarre, NumCar, 1) Case "-" Hauteur = Hauteur - Decalage NumCar = NumCar + 1 Case "+" Hauteur = Hauteur + Decalage NumCar = NumCar + 1 Case "0" If Barre = True Then Printer.DrawWidth = 1 Printer.Line (X + Col, Lig)-(X + BarreCourteNoire + Col, Lig + Hauteur), , BF Barre = False X = X + BarreCourteNoire Else Barre = True X = X + BarreCourteBlanche End If NumCar = NumCar + 1 Case "1" If Barre = True Then Printer.DrawWidth = 1 Printer.Line (X + Col, Lig)-(X + BarreLargeNoire + Col, Lig + Hauteur), , BF X = X + BarreLargeNoire Barre = False Else X = X + BarreLargeBlanche Barre = True End If NumCar = NumCar + 1 End Select Loop 'renvoyer ImpCodeBarre = BarreCourte End Function