XL 2010 Excel et code 128

lafont · 5 Avril 2022

Bonjour,

sous Excel ou Word je souhaiterai savoir si une police de caractère code 128 à télécharger peut transformer la séquence CIQ1 (Arial par exemple) en un code barre code 128 lisible par une douchette (type motorola DS4208).
Quand je teste des polices code 128, les codes générés sont illisibles .
Cela fonctionne en code 39 (!?)

Merci de votre aide

Tiri

Dudu2 · 5 Avril 2022

Bonjour,

Il faut je pense disposer de la Font "Code 128" et lui envoyer le résultat de ce traitement:

VB:

Option Explicit

'https://code.adonline.id.au/easily-generate-code-128-barcodes-in-excel/

Public Function CodeBarreEAN128(SourceString As String) As String
    'Written by Philip Treacy, Feb 2014
    'http://www.myonlinetraininghub.com/create-barcodes-with-excel-vba
    'This code is not guaranteed to be error free.  No warranty is implied or expressed. Use at your own risk and carry out your own testing
    'This function is governed by the GNU Lesser General Public License (GNU LGPL) Ver 3
    'Input Parameters : A string
    'Return : 1. An encoded string which produces a bar code when dispayed using the CODE128.TTF font
    '         2. An empty string if the input parameter contains invalid characters
    Dim Counter As Integer
    Dim CheckSum As Long
    Dim Mini As Integer
    Dim Dummy As Integer
    Dim UseTableB As Boolean
    Dim Code128_Barcode As String
   
    If Len(SourceString) = 0 Then Exit Function
   
    'Check for valid characters
    For Counter = 1 To Len(SourceString)
        Select Case Asc(Mid(SourceString, Counter, 1))
            Case 32 To 126, 203
            Case Else
                MsgBox "Invalid character in barcode string." & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
                Exit Function
        End Select
    Next
   
    Code128_Barcode = ""
    UseTableB = True
    Counter = 1
   
    Do While Counter <= Len(SourceString)
        If UseTableB Then
            'Check if we can switch to Table C
            Mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
            GoSub Testnum
           
            If Mini < 0 Then 'Use Table C
                If Counter = 1 Then
                    Code128_Barcode = Chr(205)
                Else 'Switch to table C
                    Code128_Barcode = Code128_Barcode & Chr(199)
                End If
                UseTableB = False
            Else
                If Counter = 1 Then Code128_Barcode = Chr(204) 'Starting with table B
            End If
        End If
       
        If Not UseTableB Then
            'We are using Table C, try to process 2 digits
            Mini = 2
            GoSub Testnum
           
            If Mini < 0 Then 'OK for 2 digits, process it
                Dummy = Val(Mid(SourceString, Counter, 2))
                Dummy = IIf(Dummy < 95, Dummy + 32, Dummy + 100)
                Code128_Barcode = Code128_Barcode & Chr(Dummy)
                Counter = Counter + 2
            Else 'We haven't got 2 digits, switch to Table B
                Code128_Barcode = Code128_Barcode & Chr(200)
                UseTableB = True
            End If
        End If
       
        If UseTableB Then
            'Process 1 digit with table B
            Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
            Counter = Counter + 1
        End If
    Loop
   
    'Calculation of the checksum
    For Counter = 1 To Len(Code128_Barcode)
        Dummy = Asc(Mid(Code128_Barcode, Counter, 1))
        Dummy = IIf(Dummy < 127, Dummy - 32, Dummy - 100)
        If Counter = 1 Then CheckSum = Dummy
        CheckSum = (CheckSum + (Counter - 1) * Dummy) Mod 103
    Next
   
    'Calculation of the checksum ASCII code
    CheckSum = IIf(CheckSum < 95, CheckSum + 32, CheckSum + 100)
   
    'Add the checksum and the STOP
    Code128_Barcode = Code128_Barcode & Chr(CheckSum) & Chr$(206)
   
    'Return value
    CodeBarreEAN128 = Code128_Barcode
    Exit Function
   
Testnum:
        'if the Mini characters from Counter are numeric, then Mini=0
        Mini = Mini - 1
        If Counter + Mini <= Len(SourceString) Then
            Do While Mini >= 0
                If Asc(Mid(SourceString, Counter + Mini, 1)) < 48 Or Asc(Mid(SourceString, Counter + Mini, 1)) > 57 Then Exit Do
                Mini = Mini - 1
            Loop
        End If
        Return
End Function

xhudi69 · 7 Avril 2022

Bonjour à tous,

la mine d'or c'est par là

beusse · 8 Juin 2022

Bonjour
j'ai essayé le fichier disponible sur le Grand Zebu (avec la police du site) mais ca me donne un résultat plutôt curieux :

Comme s'il manquait des caractères dans la police, quelqu'un aurait une idée ? (j'utilise excel 365 sous windows 10)
Merci

Dudu2 · 8 Juin 2022

Bonjour,

Et il ne t'est pas venu à l'idée une seule seconde d'essayer le code que j'ai placé à ton intention ?

Edit:
Font "Code 128": https://www.fonts4free.net/code-128-font.html
Source code: https://code.adonline.id.au/easily-generate-code-128-barcodes-in-excel/

beusse · 8 Juin 2022

Tu te trompes de personne, ce n'est pas à moi que tu répondais avec ton code. J'ai quand même testé ce que tu as posté et ca me fait pareil.

Dudu2 · 8 Juin 2022

Tu te trompes de personne

En effet, désolé. je n'ai pas vérifié car il me semblait naturel que ce soit le demandeur qui réponde aux solutions.

J'ai quand même testé ce que tu as posté et ca me fait pareil.

Ça me parait peu probable. As-tu ouvert le fichier que j'ai posté en Post #5 avec ce même code ?

beusse · 8 Juin 2022

J'ai résolu mes problèmes, pour le code de Grand Zebu, ça venait de la :

la case Béta était cochée.

J'ai réessayé avec ton fichier et la c'était un problème de police, j'ai 2 fois la police code128, avec celle que j'ai pris sur le Grand zebu, ca merdait, par contre avec ton lien ca fonctionne (et a l'inverse, ta police avec le code du grand zebu, ça déconne)

Merci

Deadpool_CC · 8 Juin 2022

lafont à dit:
sous Excel ou Word je souhaiterai savoir si une police de caractère code 128 à télécharger peut transformer la séquence CIQ1 (Arial par exemple) en un code barre code 128 lisible par une douchette (type motorola DS4208).

Bonjour,

vu que pour excel c'est déjà répondu ... pour Word (en publipostage) je te conseille d'utiliser la fonction intégrer qui va te générer le code barre automatiquement

Codes de champ : MergeBarcode - Support Microsoft

support.microsoft.com

habib052012 · 4 Août 2022

Dudu2 à dit:

Bonjour,

Il faut je pense disposer de la Font "Code 128" et lui envoyer le résultat de ce traitement:

VB:

Option Explicit

'https://code.adonline.id.au/easily-generate-code-128-barcodes-in-excel/

Public Function CodeBarreEAN128(SourceString As String) As String
    'Written by Philip Treacy, Feb 2014
    'http://www.myonlinetraininghub.com/create-barcodes-with-excel-vba
    'This code is not guaranteed to be error free.  No warranty is implied or expressed. Use at your own risk and carry out your own testing
    'This function is governed by the GNU Lesser General Public License (GNU LGPL) Ver 3
    'Input Parameters : A string
    'Return : 1. An encoded string which produces a bar code when dispayed using the CODE128.TTF font
    '         2. An empty string if the input parameter contains invalid characters
    Dim Counter As Integer
    Dim CheckSum As Long
    Dim Mini As Integer
    Dim Dummy As Integer
    Dim UseTableB As Boolean
    Dim Code128_Barcode As String
  
    If Len(SourceString) = 0 Then Exit Function
  
    'Check for valid characters
    For Counter = 1 To Len(SourceString)
        Select Case Asc(Mid(SourceString, Counter, 1))
            Case 32 To 126, 203
            Case Else
                MsgBox "Invalid character in barcode string." & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
                Exit Function
        End Select
    Next
  
    Code128_Barcode = ""
    UseTableB = True
    Counter = 1
  
    Do While Counter <= Len(SourceString)
        If UseTableB Then
            'Check if we can switch to Table C
            Mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
            GoSub Testnum
          
            If Mini < 0 Then 'Use Table C
                If Counter = 1 Then
                    Code128_Barcode = Chr(205)
                Else 'Switch to table C
                    Code128_Barcode = Code128_Barcode & Chr(199)
                End If
                UseTableB = False
            Else
                If Counter = 1 Then Code128_Barcode = Chr(204) 'Starting with table B
            End If
        End If
      
        If Not UseTableB Then
            'We are using Table C, try to process 2 digits
            Mini = 2
            GoSub Testnum
          
            If Mini < 0 Then 'OK for 2 digits, process it
                Dummy = Val(Mid(SourceString, Counter, 2))
                Dummy = IIf(Dummy < 95, Dummy + 32, Dummy + 100)
                Code128_Barcode = Code128_Barcode & Chr(Dummy)
                Counter = Counter + 2
            Else 'We haven't got 2 digits, switch to Table B
                Code128_Barcode = Code128_Barcode & Chr(200)
                UseTableB = True
            End If
        End If
      
        If UseTableB Then
            'Process 1 digit with table B
            Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
            Counter = Counter + 1
        End If
    Loop
  
    'Calculation of the checksum
    For Counter = 1 To Len(Code128_Barcode)
        Dummy = Asc(Mid(Code128_Barcode, Counter, 1))
        Dummy = IIf(Dummy < 127, Dummy - 32, Dummy - 100)
        If Counter = 1 Then CheckSum = Dummy
        CheckSum = (CheckSum + (Counter - 1) * Dummy) Mod 103
    Next
  
    'Calculation of the checksum ASCII code
    CheckSum = IIf(CheckSum < 95, CheckSum + 32, CheckSum + 100)
  
    'Add the checksum and the STOP
    Code128_Barcode = Code128_Barcode & Chr(CheckSum) & Chr$(206)
  
    'Return value
    CodeBarreEAN128 = Code128_Barcode
    Exit Function
  
Testnum:
        'if the Mini characters from Counter are numeric, then Mini=0
        Mini = Mini - 1
        If Counter + Mini <= Len(SourceString) Then
            Do While Mini >= 0
                If Asc(Mid(SourceString, Counter + Mini, 1)) < 48 Or Asc(Mid(SourceString, Counter + Mini, 1)) > 57 Then Exit Do
                Mini = Mini - 1
            Loop
        End If
        Return
End Function

Quel est la meilleur methode pour créer un script

jonathan008 · 5 Avril 2023

Bonjour Dudu, en lisant tes commentaires je me disais que peut être que tu allais avoir la réponse à ma question .
J’ai besoin d’une macro pour générer code barre 128 mais qui prend en compte les séquences d’échappements tel que \t pour la tabulation . Mon projet est remplir plusieurs champs (collonnes avec un seul code barre )
Merci d’avance

Dudu2 · 5 Avril 2023

Bonjour @jonathan008,

En principe je ne me connecte plus sur ce forum sauf pour mettre à jour les Ressources que j'ai créées et répondre aux discussions qui s'y réfèrent.

Mais je vais regarder ta question.
Quelles séquences d'échappement tu veux utiliser parmi celles-ci (en page 17) ?
Ou seulement les \F pour FNC1, \t pour TAB, \n pour ENTRÉE ?

Mise à jour:
Hélas le code dont je dispose ne traite pas les Escape Sequences.
De plus je n'ai RIEN trouvé sur Internet pour un code qui les traiterait à part les DLL de TEC-IT à $92. Sans ça, la mission va être quasi-impossible Maverik. Mais ça vaut peut-être le coup si ton besoin est professionnel.

jonathan008 · 5 Avril 2023

Merci pour ta réactivité Dudu ,
Je veux uniquement \t pour tabulation pour séquence d’échappement.

Et oui c’est pour du professionnel. En quoi consiste le DLL de TEC-IT .
Je suppose que c’est un add -in.
Il faut que je fasse une thèse 🤦‍♂️😅 pour convaincre le service IT sécurité de ma boîte que ce site est fiable afin qu’il puisse me laissé installer ça sur mon ordi .

Si toute tu as une alternative tiens moi au courant .
Merci bonne soirée

Staple1600 · 5 Avril 2023

Bonsoir @jonathan008, le fil

(salutations Dudu2, je ne savais pas que tu étais parti)

@Dudu2
[Juste pour infos]
Une information qui a son importance

jonathan008 à dit:
Merci beaucoup pour ces pistes Sylvanu, avec mon mac je n'arrive pas faire le test car il me mets OE a la fin du code barre je pense que c'est la police qui est instalé sur mon mac qui genere ce probleme. je vais essayer sur celui du boulot .

Dudu2 · 5 Avril 2023

Bonsoir @Staple1600,

(salutations Dudu2, je ne savais pas que tu étais parti)

J'ai pris du recul à cause du trop de temps passé sur le forum et aussi à cause de discussions parfois "inconfortables" dirons-nous. Je fais du VBA depuis 6 ans maintenant, ai aidé des tas de gens et en ai appris assez pour répondre à presque toutes les problématiques. Je réserve mon temps de code à la maintenance de grosses applications de quelques fidèles.

Il faut que je fasse une thèse 🤦‍♂️😅 pour convaincre le service IT sécurité de ma boîte que ce site est fiable afin qu’il puisse me laissé installer ça sur mon ordi .

Je pense que justement, le fait de passer par ton service Achats après vérification de la Sécurité IT devrait valider l'acquisition d'un produit professionnel. C'est pas comme si tu téléchargeais un code de Dudu2 😂 !
Il faut juste que tu te renseignes auprès du support de TEC-IT que ce que tu veux faire en VBA Excel est couvert par leur produit. Ils te donneront sûrement des indications de mise en œuvre.

Effectuez une recherche sur Excel Downloads...

XL 2010 Excel et code 128

lafont

XLDnaute Nouveau

Pièces jointes

Dudu2

XLDnaute Barbatruc

xhudi69

XLDnaute Accro

beusse

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Pièces jointes

beusse

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

beusse

XLDnaute Nouveau

Deadpool_CC

XLDnaute Accro

Codes de champ : MergeBarcode - Support Microsoft

habib052012

XLDnaute Nouveau

jonathan008

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

jonathan008

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée