Const KTbA = "ABCDEFGHIJ", KTbB = "KLMNOPQRST", KTbC = "abcdefghij"
Const KCode = "AAAAAAAABABBAABBABAABBBAABAABBABBAABABBBAAABABABABABBAABBABA"
Public Const KEAN13 = "EAN13.TTF"
Function FEAN13$(ByVal Chaine$)
'si la chaine envoyée a plus de 12 caractères, elle est tronquée
Application.Volatile
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
FEAN13 = 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$(FEAN13, Bcle, 1) = Mid$(KTbA, Mid$(Chaine, Bcle, 1) + 1, 1)
Else
Mid$(FEAN13, Bcle, 1) = Mid$(KTbB, Mid$(Chaine, Bcle, 1) + 1, 1)
End If
Next Bcle
For Bcle = 8 To 13
Mid$(FEAN13, Bcle + 1, 1) = Mid$(KTbC, Mid$(Chaine, Bcle, 1) + 1, 1)
Next Bcle
End Function