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
Merci de votre aide
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