codebarre =Code128

[gothc]

Bonsoir
j'ai un probleme avec mon codebarre qui ne fonctionne pas
=Code128(D3)

Merci

 

[Lolote83]

Re : codebarre =Code128

Salut GOTHC,
peut être touveras tu ta réponse ici:
https://www.excel-downloads.com/threads/generer-code-barre-128.92727/
@+ Lolote83

 

[gothc]

Re : codebarre =Code128

je comprends pas arfff je trouve des fichiers sur le net le code fonctionne mais pas sur mon fichier en piéce jointe
sniff bizarre

 

[Staple1600]

Re : codebarre =Code128

Bonsoir à tous

gothc
Tu as bien installé la police ?
comme indiqué ici
https://www.excel-downloads.com/threads/generer-code-barre-128.92727/
(NB: même source que Lolo83

 

[gothc]

Re : codebarre =Code128

Oui j'ai bien la police 128 installé sur mon Pc

 

[gothc]

Re : codebarre =Code128

jai la reponse
merci
Public Function Code128$(chaine$)
'V 1.0
'Paramètres : 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
Dim i%, checksum&, mini%, dummy%, tableB As Boolean
Code128$ = ""
If Len(chaine$) > 0 Then
'Vérifier si caractères valides
For i% = 1 To Len(chaine$)
Select Case Asc(Mid$(chaine$, i%, 1))
Case 32 To 126
Case Else
i% = 0
Exit For
End Select
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
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
mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
GoSub testnum
If mini% < 0 Then 'Choix table C
If i% = 1 Then 'Débuter sur table C
Code128$ = Chr$(205)
Else 'Commuter sur table C
Code128$ = Code128$ & Chr$(199)
End If
tableB = False
Else
If i% = 1 Then Code128$ = Chr$(204) '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
GoSub testnum
If mini% < 0 Then 'OK pour 2 chiffres, les traiter
dummy% = Val(Mid$(chaine$, i%, 2))
dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
Code128$ = Code128$ & Chr$(dummy%)
i% = i% + 2
Else 'On n'a pas 2 chiffres, repasser en table B
Code128$ = Code128$ & Chr$(200)
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))
dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
If i% = 1 Then checksum& = dummy%
checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
Next
'Calcul du code ASCII de la clé
checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 100)
'Ajout de la clé et du STOP
Code128$ = Code128$ & Chr$(checksum&) & Chr$(206)
End If
End If
Exit Function
testnum:
'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
Return
End Function