XL 2016 code barre EAN13

gothc

XLDnaute Occasionnel
Bonsoir le forum
j'ai un petit problème pour le fonctionnement des codes barres EAN13 sur le fichier (bon fichier) ci joint la macro ne fonctionne pas je pense un conflit avec une autre Macro présente
Option Explicit
'!Ti - Thierry Pourtier : xlti@wanadoo.fr
'!http://www.veriti.net
'!septembre 2006 - v.1.00

'adapté en partie d'après un code de GrandZebu
'http://grandzebu.net/informatique/codbar/codbar.htm
'et destiné à être utilisé avec ses polices Code barre

Const KDigits = "0123456789"
Const KTbA = "ABCDEFGHIJ", KTbB = "KLMNOPQRST", KTbC = "abcdefghij"
Const KTbD = "0123456789", KtbE = "klmnopqrst"
Const KCode = "AAAAAAAABABBAABBABAABBBAABAABBABBAABABBBAAABABABABABBAABBABA"

'police utilisée avec ce module
Public Const KEAN13 = "EAN13.TTF"

Function EAN13$(ByVal Chaine$)
'si la chaine envoyée a plus de 12 caractères, elle est tronquée
Dim Bcle%, Codage$, Check&, Car$

Chaine = Left$(Chaine, 12)
If Len(Chaine) < 12 Then Exit Function

'Vérifier qu'il y a 12 chiffres
For Bcle = 1 To 12
Car = Mid$(Chaine, Bcle, 1)
If Car < "0" Or Car > "9" Then Exit Function
Check = Check + Car * (2 * ((Bcle - 1) Mod 2) + 1)
Next Bcle
Chaine = Chaine & 10 - (Check Mod 10) Mod 10

EAN13 = Left$(Chaine, 1) & Space$(6) & "*" & Space(6) & "+"
Codage = Mid$(KCode, Left$(Chaine, 1) * 6 + 1, 6)

For Bcle = 2 To 7
If Mid$(Codage, Bcle - 1, 1) = "A" Then
Mid$(EAN13, Bcle, 1) = Mid$(KTbA, Mid$(Chaine, Bcle, 1) + 1, 1)
Else
Mid$(EAN13, Bcle, 1) = Mid$(KTbB, Mid$(Chaine, Bcle, 1) + 1, 1)
End If
Next Bcle

For Bcle = 8 To 13
Mid$(EAN13, Bcle + 1, 1) = Mid$(KTbC, Mid$(Chaine, Bcle, 1) + 1, 1)
Next Bcle
End Function

Function EAN8$(ByVal Chaine$)
'si la chaine envoyée a plus de 7 caractères, elle est tronquée
Dim Bcle%, Car$, Check%

Chaine = Left$(Chaine, 7)
If Len(Chaine) < 7 Then Exit Function
'Vérifier qu'il y a 7 chiffres
For Bcle = 1 To 7
Car = Mid$(Chaine, Bcle, 1)
If Car < "0" Or Car > "9" Then Exit Function
Check = Check + Car * (2 * (Bcle Mod 2) + 1)
Next Bcle
'Calcul de la clé de contrôle
Chaine = Chaine & 10 - (Check Mod 10) Mod 10

EAN8 = ":" & Space$(4) & "*" & Space(4) & "+"
For Bcle = 1 To 4
Mid$(EAN8, Bcle + 1, 1) = Mid$(KTbA, Mid$(Chaine, Bcle, 1) + 1, 1)
Next Bcle
For Bcle = 5 To 8
Mid$(EAN8, Bcle + 2, 1) = Mid$(KTbC, Mid$(Chaine, Bcle, 1) + 1, 1)
Next Bcle
End Function
945678210604=EAN13(A4) pour avoir le code Barre

Merci de votre aide
 

Pièces jointes

  • bon fichier.xlsm
    26.1 KB · Affichages: 35
  • Codes Barres.xls
    47.5 KB · Affichages: 42

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla