Impression de codes barres code 39

Soyez le premier à donner votre avis sur cette source.

Vue 33 552 fois - Téléchargée 3 605 fois

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.

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. :)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cannibal20
Messages postés
1
Date d'inscription
samedi 2 octobre 2004
Statut
Membre
Dernière intervention
7 septembre 2007
-
POUR LES LETTRES IL SUFFIT DE MODIFIER CECI:

Public Function CodeBarreCode39(pCodeBar As String, Col As Long, Lig As Long, Optional Hauteur As Long 800, Optional largeur As Long 1500)

Dim TJA(255) 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" '= 0
TJA(1) = "1001000010" '= 1
TJA(2) = "0011000010" '= 2
TJA(3) = "1011000000" '= 3
TJA(4) = "0001100010" '= 4
TJA(5) = "1001100000" '= 5
TJA(6) = "0011100000" '= 6
TJA(7) = "0001001010" '= 7
TJA(8) = "1001001000" '= 8
TJA(9) = "0011001000" '= 9
TJA(10) = "0100101000" '= CARATÈRE DÉBUT ET FIN
TJA(32) = "0110001000" '= SPACES
TJA(36) = "0101010000" '= $
TJA(37) = "0001010100" '= %
TJA(42) = "0100101000" '= * & CARATÈRE DÉBUT ET FIN
TJA(43) = "0100010100" '= +
TJA(45) = "0100001010" '= -
TJA(46) = "1100001000" '= .
TJA(47) = "0101000100" '= /
TJA(65) = "1000010010" '= A
TJA(66) = "0010010010" '= B
TJA(67) = "1010010000" '= C
TJA(68) = "0000110010" '= D
TJA(69) = "1000110000" '= E
TJA(70) = "0010110000" '= F
TJA(71) = "0000011010" '= G
TJA(72) = "1000011000" '= H
TJA(73) = "0010011000" '= I
TJA(74) = "0000111000" '= J
TJA(75) = "1000000110" '= K
TJA(76) = "0010000110" '= L
TJA(77) = "1010000100" '= M
TJA(78) = "0000100110" '= N
TJA(79) = "1000100100" '= O
TJA(80) = "0010100100" '= P
TJA(81) = "0000001110" '= Q
TJA(82) = "1000001100" '= R
TJA(83) = "0010001100" '= S
TJA(84) = "0000101100" '= T
TJA(85) = "1100000010" '= U
TJA(86) = "0110000010" '= V
TJA(87) = "1110000000" '= W
TJA(88) = "0100100010" '= X
TJA(89) = "1100100000" '= Y
TJA(90) = "0110100000" '= Z

'//==== 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)
If IsNumeric(Mid(CodeBar, Ind, 1)) Then
Chiffre = Val(Mid(CodeBar, Ind, 1))
Else
Chiffre = Val(Asc(UCase(Mid(CodeBar, Ind, 1))))
End If

CodeChiffre = CodeChiffre + TJA(Chiffre)
Next Ind
SilverSurfeur
Messages postés
21
Date d'inscription
mercredi 23 juillet 2003
Statut
Membre
Dernière intervention
26 mars 2004
-
Les lettres ne sont pas gérées pour ce programme ci.

Mais comme je l'ai dit plus haut, il suffit de modifier le programme pour correspondre à d'éventuelles normes pour le code 39.
zoizome
Messages postés
3
Date d'inscription
dimanche 13 juillet 2003
Statut
Membre
Dernière intervention
14 novembre 2005
-
Et comment faire pour les lettres ?
TJA(A) = "??????????"
TJA(B) = "??????????"
...

:(
bleva
Messages postés
3
Date d'inscription
lundi 28 avril 2003
Statut
Membre
Dernière intervention
15 avril 2004
-
Je te remercie de ta reponse mais j'ai reussi a contourner le probleme en passant par l'impression en code 128 avec la police et ca marche nickel
SilverSurfeur
Messages postés
21
Date d'inscription
mercredi 23 juillet 2003
Statut
Membre
Dernière intervention
26 mars 2004
-
Pour l'impression des lettres en code 39, je ne sais po si c'est possible. Il faudrait récupérer la doc complète sur le code 39 et voir si des codes sont disponibles pour les lettres.

Logiquement, ce serait possible vu que, comme est défini le code 39, il peut y avoir jusqu'à 84 combinaisons et donc 84 caractères : Bien assez pour coder les 10 chiffres et les 26 lettres de l'alphabet en majuscules et en minuscules.

Il suffit donc de vérifier dans la norme du code 39 si c'est bien définit.

Pour mon programme, je propose de remplacer le tableau TJA par un tableau dont l'index correspond à la valeur ASCII de la lettre à coder. A tester...

Bonne chance !!!

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.