Cette fonction VBScript retourne une chaîne de caractère calculée pour être utilisée avec la police CODE128.TTF.
Pour utiliser cette fonction, partez du code Adelia du modulo 97 d'un IBAN et adaptez le.
Codes à barres de symbologie Code 128
Les polices de codes à barres QuartetBar Code 128 répondent à la norme française et européenne NF EN 799 qui définit la symbologie de codes à barres connue sous le nom Code 128. Elles mettent à disposition les trois jeux A, B et C du standard de codes à barres Code 128 pour fournir des symboles soit mono-jeu soit multi-jeux de largeur optimisée.
Information à coder
L’information à coder peut être de longueur quelconque, composée de chiffres, majuscules, minuscules, signes et caractères de contrôle d'ordre ASCII compris entre 0 et 127 (dont tabulation d'ordre 9 et changements de ligne d'ordre 10 et/ou 13), ainsi que de quatre caractères spécifiques au Code 128, appelés FNC1, FNC2, FNC3 et FNC4, qui n'ont pas de représentation graphique mais dont l'usage standardisé précise le sens de l'information qui les suit.
'********************************************************************* ' Calcul la chaine de caractère pour utiliser ' la police code barre 128 ' '********************************************************************* ' ' HARDIS - Code128 - 2009 ' '********************************************************************* Option Explicit 'All variables have to be declared before use Dim chaine Dim Machaine Dim i, checksum, mini, dummy Dim tableB Public Function Code128(chaine) ' Paramètre : une chaine ' Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre ' * une chaine vide si paramètre fourni incorrect Code128 = "" If Len(chaine) > 0 Then ' Vérifier si caractères valides For i = 1 To Len(chaine) IF (Asc(Mid(chaine, i, 1)) >= 32 and Asc(Mid(chaine, i, 1))<= 126) or (Asc(Mid(chaine, i, 1)) = 203) then ' rien ELSE i = 0 Exit FOR END IF Next ' Calculer la chaine de code en optimisant l'usage des tables B et C Code128 = "" tableB = True If i > 0 Then i = 1 'i% devient l'index sur la chaine / i% become the string index Do While i <= Len(chaine) If tableB Then ' Voir si intéressant de passer en table C ' Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres IF i = 1 Or i + 3 = Len(chaine) THEN mini = 4 ELSE mini = 6 END IF Testnum mini, chaine, i If mini < 0 Then ' Choix table C If i = 1 Then ' Débuter sur table C Code128 = Chr(210) Else ' Commuter sur table C Code128 = Code128 & Chr(204) End If tableB = False Else If i = 1 Then Code128 = Chr(209) ' Débuter sur table B End If End If If Not tableB Then ' On est sur la table C, essayer de traiter 2 chiffres mini = 2 Testnum mini, chaine, i If mini < 0 Then ' OK pour 2 chiffres, les traiter dummy = Cint(Mid(chaine, i, 2)) if dummy < 95 then dummy = dummy + 32 else dummy = dummy + 105 end if Code128 = Code128 & Chr(dummy) i = i + 2 Else ' On n'a pas 2 chiffres, repasser en table B Code128 = Code128 & Chr(205) tableB = True End If End If If tableB Then ' Traiter 1 caractère en table B Code128 = Code128 & Mid(chaine, i, 1) i = i + 1 End If Loop ' Calcul de la clé de contrôle For i = 1 To Len(Code128) dummy = Asc(Mid(Code128, i, 1)) If dummy < 127 then dummy = dummy - 32 else dummy = dummy - 105 end if If i = 1 Then checksum = dummy checksum = (checksum + (i - 1) * dummy) Mod 103 Next ' Calcul du code ASCII de la clé IF checksum < 95 then checksum = checksum + 32 else checksum = checksum + 105 end if ' Ajout de la clé et du STOP Code128 = Code128 & Chr(checksum) & Chr(211) End If End If Exit Function End Function SUB TESTNUM(mini, chaine, i) ' si les mini% caractères à partir de i% sont numériques, alors mini%=0 mini = mini - 1 If i + mini <= Len(chaine) Then Do While mini >= 0 If Asc(Mid(chaine, i + mini, 1)) < 48 Or Asc(Mid(chaine, i + mini, 1)) > 57 Then Exit Do mini = mini - 1 Loop End If End Sub