XL 2016 Code barre qui ne s'affiche plus

davidp

XLDnaute Occasionnel
Bonjour le forum ,

désolé de vous déranger , mais avant d'avancer sur un projet , j'ai le problème ci-dessous

1- j'ai passé le fichier en annexe d'excel 97/2003 en version .XLSM et maintenant le Code EAN en colonne E ne s'affiche plus .

2- En axe d'amélioration , serait-il possible que lorsque je colle les EAN 13 dans la colonne H , qu'une macro rajoute des zéros devant avant d'arriver à 13 caractères si cela n'est pas le cas .

Un grand merci d'avance à ceux qui pourront m'aider .

Bonne dimanche
David
 

Pièces jointes

  • V1.xlsm
    87 KB · Affichages: 24

davidp

XLDnaute Occasionnel
Bonjour Jmfmarques ,

pour le point N°2 , merci c'est résolu avec la macro ci-dessous
-------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Range("H3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0000000000000"
End Sub
-------------------------------------------------------------------------
Merci pour ton aide

bon dimanche

DAVIDP
 

jmfmarques

XLDnaute Accro
Une "sélection" tremplin est inutile et alourdit.
On traite directement les objets Excel. Ainsi (exemple pour formater de A3 à la dernière ligne remplie de la colonne A) :
VB:
range("A3:A" & range("A" & rows.count).end(xlup).row).numberformat = "0000000000000"
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Dans votre colonne D à partir de la ligne 3, votre fonction Ean13 est appelée par = _ean13(C3) 'un underscore précédant le nom.

Sur toute votre colonne et après sélection, remplacer (CTRL+H) _ean13(C3) par Ean13(C3) pour enlever l'underscore qui précède.

Si cela ne suffit pas, voyez si vous avez toujours la police de caractères correspondante (EAN13.TTF)

cordialement
 

davidp

XLDnaute Occasionnel
Bonjour Roblochon ,

merci pour ton aide , j'ai testé en enlevant l'underscore qui précède et j'ai toujours le même problème et j'ai bien la Police EAN13 sur mon PC .

Ce n'est pas dramatique , au pire des cas , je vais rester sur l'ancien fichier qui est en excel 97_2003

Ps: la macro ci-dessous qui fonctionnait sur la version excel 97_2003 .

Bon dimanche

DAVIDP
-----------------------------------------------------------------------------------------
Public Function ean13$(chaine$)
'V 1.0
'Paramètres : une chaine de 12 chiffres
'Retour : * une chaine qui, affichée avec la police EAN13.TTF, donne le code barre
' * une chaine vide si paramètre fourni incorrect
Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
ean13$ = ""
'Vérifier qu'il y a 12 caractères
If Len(chaine$) = 12 Then
'Et que ce sont bien des chiffres
For i% = 1 To 12
If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, 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$(chaine$, i%, 1))
Next
checksum% = checksum% * 3
For i% = 1 To 11 Step 2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
'Le premier chiffre est pris tel quel, le deuxième vient de la table A
CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
first% = Val(Left$(chaine$, 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
CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
Else
CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
End If
Next
CodeBarre$ = CodeBarre$ & "*" 'Ajout séparateur central
For i% = 8 To 13
CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
Next
CodeBarre$ = CodeBarre$ & "+" 'Ajout de la marque de fin
ean13$ = CodeBarre$
End If
End If
End Function

Bon dimanche
DAVIDP
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

jusqu'à ce que je me souvienne que EAN13 est une adresse de cellule : colonne EAN ligne 13 !!!!!

Copier coller la fonction ci-dessous en lieu et place de votre fonction ean13$ et appelez-la dans votre feuille : =CodeEAN13(C3)
VB:
Public Function CodeEan13(ByVal chaine$) As String

  'V 1.0
  'Paramètres : une chaine de 12 chiffres
  'Retour : * une chaine qui, affichée avec la police CodeEan13.TTF, donne le code barre
  '         * une chaine vide si paramètre fourni incorrect
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  CodeEan13 = ""
  'Vérifier qu'il y a 12 caractères
  If Len(chaine$) = 12 Then
    'Et que ce sont bien des chiffres
    For i% = 1 To 12
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, 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$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 1 To 11 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'Le premier chiffre est pris tel quel, le deuxième vient de la table A
      CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
      first% = Val(Left$(chaine$, 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
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
       Else
         CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
       End If
     Next
      CodeBarre$ = CodeBarre$ & "*"   'Ajout séparateur central
      For i% = 8 To 13
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Ajout de la marque de fin
      CodeEan13 = CodeBarre$
    End If
  End If
End Function
...et tout ira bien.
 

davidp

XLDnaute Occasionnel
Un grand merci Roblochon ,

c'est parfait cela fonctionne !
je n'aurai jamais réussi sans votre aide

Encore merci et bon dimanche
DavidP
1587291207418.png

Encore merci et bon dimanche
DAVIDP
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 329
Messages
2 087 334
Membres
103 519
dernier inscrit
Thomas_grc11