Routine per codice a barre ean 13

Question

Buona sera

Nel sito Grandzebu.net ho scaricato l'occorrente per realizzare un codice a barre ean 13. L'esempio è fatto con Excel 2003 e funziona. Salvato con Excel 2007 con attivazione delle macro trasforma ean13 in _ean13 per incompatibilità con Excel. Ho provato a modificare la routine in EAN13, che accetta, ma la routine non funziona, sulla cella appare errore di riferimento cella non valida.

La routine di Excel 2003 è la seguente:

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

Answer 1

Ciao Giorgio,

Prova il seguente adattamento della funzione che sostituisce Ean13 con MyEan13:

'=========>>

Option Explicit

'--------->>

Public Function MyEan13(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

  MyEan13 = ""

  '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

      MyEan13 = CodeBarre$

    End If

  End If

End Function

'<<=========

===

Regards,

Norman

Answer 2

Ciao Giorgio,

A volte la risposta è ovvia. Ho provato a modificare in vari modi il riferimento senza provare MyEan13 che funziona.

Mi fa piacere che hai risolto il problema e ti ringrazio del tuo cortese riscontro.

Per chiudere questo thread, vorrei gentilmente chiederti di segnare la mia risposta come Risposta. In questo modo, tu aiuterai anche coloro che potrebbero cercare soluzioni ai problemi simili negli archivi della comunità.

Alla prossima!

===

Regards,

Norman

Answer 3

A volte la risposta è ovvia. Ho provato a modificare in vari modi il riferimento senza provare MyEan13 che funziona.

Grazie