Impression de codes barres code 39
Description
Ces deux méthodes permettent d'imprimer un code barre en code 39 sur l'imprimante par défaut. Vous pouvez modifier la taille et la position du code barre. Le numéro du code barre s'imprime en dessous du code barre.
Ces deux méthodes n'impriment que les codes barres constitués de chiffres (les lettres font planter le programme) mais la modification du code pour inclure les lettres ne devrait pas être très difficile.
Merci à Beben42. Mon code est totalement inspiré de son code pour l'impression d'un code barre EAN13. :)
Ces deux méthodes n'impriment que les codes barres constitués de chiffres (les lettres font planter le programme) mais la modification du code pour inclure les lettres ne devrait pas être très difficile.
Source / Exemple :
'==============================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
Conclusion :
Merci à Beben42. Mon code est totalement inspiré de son code pour l'impression d'un code barre EAN13. :)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.