Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Function upcean13(ByVal MYNUMBER)
If Len(MYNUMBER) = 13 Then MYNUMBER = Mid(MYNUMBER, 1, 11)
Dim i%, checksum%, first%, EAN13$, tableA As Boolean
'Vérifier qu'il y a 12 caractères
If Len(MYNUMBER) = 12 Then
'Et que ce sont bien des chiffres
MYNUMBER = "0" & Mid$(MYNUMBER, 1, 12)
For i% = 1 To 12
If Asc(Mid$(MYNUMBER, i%, 1)) < 48 Or Asc(Mid$(MYNUMBER, i%, 1)) > 57 Then
i% = 0
Exit For
End If
Next
If i% = 13 Then
'Calcul de la clé de contrôle
For i = 2 To 12 Step 2
checksum = checksum + Val(Mid$(MYNUMBER, i%, 1))
Next
checksum = checksum * 3
For i = 1 To 11 Step 2
checksum = checksum + Val(Mid$(MYNUMBER, i, 1))
Next
MYNUMBER = MYNUMBER & (10 - checksum Mod 10) Mod 10
'Le premier chiffre est pris tel quel, le deuxième vient de la table A
upcean13 = Left$(MYNUMBER, 1) & Chr$(65 + Val(Mid$(MYNUMBER, 2, 1)))
first = Val(Left$(MYNUMBER, 1))
For i = 3 To 7
tableA = False
Select Case i
Case 3
Select Case first
Case 0 To 3
tableA = True
End Select
Case 4
Select Case first
Case 0, 4, 7, 8
tableA = True
End Select
Case 5
Select Case first
Case 0, 1, 4, 5, 9
tableA = True
End Select
Case 6
Select Case first
Case 0, 2, 5, 6, 7
tableA = True
End Select
Case 7
Select Case first
Case 0, 3, 6, 8, 9
tableA = True
End Select
End Select
If tableA Then
upcean13 = upcean13 & Chr$(65 + Val(Mid$(MYNUMBER, i, 1)))
Else
upcean13 = upcean13 & Chr$(75 + Val(Mid$(MYNUMBER, i, 1)))
End If
Next
upcean13 = upcean13 & "*" 'Ajout séparateur central
For i = 8 To 13
upcean13 = upcean13 & Chr$(97 + Val(Mid$(MYNUMBER, i, 1)))
Next
upcean13 = upcean13 & Chr$(43) 'Ajout de la marque de fin
End If
End If
End Function