avoir un code à barres

a10

XLDnaute Impliqué
Bonjour,

Quel police et comment insérer ce type de police afin que ma cellule affiche des codes à barres.

cordialement

Alain
 

libellule85

XLDnaute Accro
Bonsoir a10, eddy1975, le forum,

Pour ma part j'utilise une macro ainsi que la police ean13.ttf

Code à mettre dans un module, et dans la cellule cible mettre =fean13(b2) par exemple
Code à adapter bien sûr


VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
314 204
Messages
2 107 186
Membres
109 770
dernier inscrit
cazenavevar