Page 1 sur 1
Calcul Cle EAN13
Publié:
25 Oct 2007 à 14:01par Michael DELIQUE
- Code : Tout sélectionner
Function CleEAN13(wEAN As String) As Integer
'Déclaration Variables
Dim EAN As String
Dim Char As String
Dim i As Integer
Dim nbCoef As Integer
On Error Goto ErreurHandle
If Trim(wEAN) = "" Then
CleEAN13 = -1
Exit Function
End If
'elemination des caracteres superflux
EAN = ""
For i = 1 To Len(wEAN)
Char = Mid(wEAN,i,1)
If Char Like "[0-9]" Then
EAN = EAN + Ucase(Char)
End If
Char = ""
Next
'si 13 caratere c'est que la clé de controle est intégré au code EAN
If Len(EAN) = 13 Then
EAN = Left(EAN,12)
End If
If Len(EAN) <> 12 Then
CleEAN13 = -1
Exit Function
End If
nbCoef = 3
CleEAN13 = 0
For i = 1 To Len(EAN)
Char = Mid(EAN,i,1)
If nbCoef = 3 Then
nbCoef = 1
Else
nbCoef = 3
End If
CleEAN13 = CleEAN13 + (Cint(Char)*nbCoef)
Char = ""
Next
EAN = ""
CleEAN13 = 10 -(CleEAN13 Mod 10)
If CleEAN13 = 10 Then
CleEAN13 = 0
End If
%REM
Wikipedia
Calcul de la clé de contrôle
Le calcul de la clé de contrôle se rapproche fortement de celui de l’ISBN même si il existe des différences assez notables.
Calculons la clé de contrôle du code à barres dérivé de la séquence 471-9512-00288-x (où x est la clé de contrôle que l’on cherche), par l’utilisation du tableau suivant :
Chiffres du code à barres 4 7 1 9 5 1 2 0 0 2 8 8
Coefficient 1 3 1 3 1 3 1 3 1 3 1 3
Résultat 4*1 7*3 1*1 9*3 5*1 1*3 2*1 0*3 0*1 2*3 8*1 8*3
4 21 1 27 5 3 2 0 0 6 8 24
Le coefficient étant alternativement 1 et 3.
Il faut ensuite calculer la somme des résultats : 4+21+1+27+5+3+2+0+0+6+8+24 = 101
On soustrait à 10 le reste de la division par 10 de la somme précédement calculée : 10 - (101 % 10) = 10 - 1 = 9
La clé de controle est donc 9. Attention : Si le résultat est 10 alors la clé vaut 0.
Le code EAN 13 complet est alors 471-9512-00288-9 (les tirets ne font pas partie du code à barres et sont rajoutés pour aider à la lecture).
%END REM
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
CleEAN13 = -1
Exit Function
End Function