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

Statistiques des forums

Discussions
312 179
Messages
2 085 989
Membres
103 081
dernier inscrit
jeromeolivier.raymond@wat