Newsgroup: it.comp.appl.access
Titolo: Codice EAN13

Salve
ho creato un form per delle tessere premio, ma vorrei che nella tessera 
venisse stampato anche il codice ean13.
i primi 12 digit vengono calcolati automaticamente dal programma.
Dovrei mettere il 13º digit e stampare il report con il barcode.
Qualcuno mi sa dire se c'è un esempio già pronto in access?
 
Vi ringrazio.
 
Saluti.
 
Stefano


per calcolare il 13imo digit in base ai primi 12 usa questa funzione
che come argomenti riceve i primi 12 digit e ti restituisce il 13imo
 
Public Function Calcola13(TestEan As String)
 
    If Not TestEan Like "############" Then 'controlla che siano 12 cifre
       CalcolaEan13 = Null
       Exit Function
    End If
    Dim i As Integer, Summ As Integer, Check As Integer
    Summ = 0
    'somma in posizione pari
    For i = 2 To 12 Step 2
       Summ = Summ + Val(Mid(TestEan, i, 1))
    Next i
    'moltiplica per 3 le cifre in posizione pari
    Summ = Summ * 3
    'somma in posizione dispari
    For i = 1 To 11 Step 2
       Summ = Summ + Val(Mid(TestEan, i, 1))
    Next i
    Summ = Summ Mod 10
    Calcola13 = (10 - Summ) Mod 10
End Function
 
per la stampa, ci sono due soluzioni
o disegnare il barcode a runtime oppure usare il font
la più rapida è usare il font
 
crei una etichetta sul report e imposti il suo font con quello ean 13
in fase di formattazione richiami la funzione FF_EAN13
 
Me.TuaEtichetta.Caption = FF_EAN13(barcodedastampare)
 
 
 
Function FF_EAN13(CodeString As String)
 
Dim V1(9, 2) As String
V1(0, 0) = "a"
V1(0, 1) = "b"
V1(0, 2) = "c"
V1(1, 0) = "d"
V1(1, 1) = "e"
V1(1, 2) = "f"
V1(2, 0) = "g"
V1(2, 1) = "h"
V1(2, 2) = "i"
V1(3, 0) = "j"
V1(3, 1) = "k"
V1(3, 2) = "l"
V1(4, 0) = "m"
V1(4, 1) = "n"
V1(4, 2) = "o"
V1(5, 0) = "p"
V1(5, 1) = "q"
V1(5, 2) = "r"
V1(6, 0) = "s"
V1(6, 1) = "t"
V1(6, 2) = "u"
V1(7, 0) = "v"
V1(7, 1) = "w"
V1(7, 2) = "x"
V1(8, 0) = "y"
V1(8, 1) = "z"
V1(8, 2) = "A"
V1(9, 0) = "B"
V1(9, 1) = "C"
V1(9, 2) = "D"
 
Dim V2(9) As String
V2(0) = "000000"
V2(1) = "001011"
V2(2) = "001101"
V2(3) = "001110"
V2(4) = "010011"
V2(5) = "011001"
V2(6) = "011100"
V2(7) = "010101"
V2(8) = "010110"
V2(9) = "011010"
 
Dim X As String
Dim Risultato As String
Dim Codifica As Integer
Dim CheckDigit As Integer
Dim i As Integer
 
X = trim(CodeString)
If Not IsNumeric(X) Or Len(CodeString) < 12 Then
     FF_EAN13 = ""
     Exit Function
End If
X = Left(CodeString, 12)
 
'Aggiunta del check-digit
CheckDigit = 0
For i = 1 To 11 Step 2
     CheckDigit = CheckDigit + Val(Mid(X, i, 1))
     CheckDigit = CheckDigit + Val(Mid(X, i + 1, 1)) * 3
Next i
CheckDigit = (10 - CheckDigit Mod 10) Mod 10
X = X & trim(str(CheckDigit))
 
'Trasformazione del 13. carattere (codificato come start/stop)
Codifica = Val(Left(X, 1))
Risultato = Left(X, 1)
 
'Trasformazione dei caratteri da 12 a 7
For i = 2 To 7
     Risultato = Risultato & V1(Val(Mid(X, i, 1)), Val(Mid(V2(Codifica), 
i - 1, 1)))
Next i
 
'Aggiunta del carattere di controllo centrale
Risultato = Risultato & "G"
 
'Trasformazione dei caratteri da 6 a 1
For i = 8 To 13
     Risultato = Risultato & V1(Val(Mid(X, i, 1)), 2)
Next i
 
'Aggiunta del carattere di start/stop finale
Risultato = Risultato & "F"
 
FF_EAN13 = Risultato
 
End Function
 
 
 
 
 
mi scuso ma non so chi ha realizzato le due funzioni. le avevo prese 
anni fa da internet
 
ciao
BFS
 


Grazie mille, lo provo subito.

Il 26/08/2019 14:16, BFS ha scritto:

La 13ª cifra funziona, ma quando ho provato a stampare il codice ean, 
c'era il campo cod_ean = 1012019090018
 
su formattazione ho inserito il seguente codice:
Me.barcode13.Caption = FF_EAN13(Me.cod_ean)
 
ma mi ha stampato un barcode
 
11 4 8 1 5 373 43 3 6 16
 
 
Ho sbagliato qualcosa?
Grazie


Ma il FONT lo hai impostato...?
 
Quì trovi un codice equivalente, ed anche il FONT [EAN13.TFF]:
http://grandzebu.net/informatique/codbar/ean13.htm
 
 
@Alex


la funzione per il codice 1012019090018 dovrebbe restituirti
1adhaeCGcDccfAF
 
e questa stringa la devi visualizzare con il font ean 13 adatto
 
se non hai il font dammi una mail valida che te lo invio
 
ciao
 
 
 
 
 
 
 

Il 26/08/2019 16:02, Stefano ha scritto:

con il tuo esempio otterresti questo
https://ibb.co/b5qfHBq
 
 
ciao

 ciao
 
Grazie mille, ho risolto.
Dopo un po di prove, con il sistema che mi hai suggerito, è andata.
Provvisoriamente, avevo scaricato e installato il tbarcode
https://www.tec-it.com/it/download/tbarcode-office/Download.aspx
 
Funziona perfettamente senza bisogno di scaricare font o altro, ma è a 
pagaemnto. Nella versione free, mette la scritta demo sul barcode.
 
Grazie ancora.
 
Ciao.

Il 26/08/2019 13:41, Stefano ha scritto:

Ciao a tutti.
Scusate se riprendo il post, ma ho trovato una soluzione che ha 
funzionato al primo colpo.
 
ho messo la funzione ean13 in un modulo.
ho quindi preso le prime 12 cifre del codice ean e ho applicato la 
funzione: me.barcode = ean13 (me.ean12cifre) con font code ean13
la funzione mi ha calcolatola tredicesima cifra.
 
a qusto punto ho calcolato la 13ª cifra usanto la funzione Calcola13.
 
Tutto risolto.
 
Grazie a tutti.
Ciao.
 
Public Function Calcola13(TestEan As String)
 
    If Not TestEan Like "############" Then 'controlla che siano 12 cifre
       CalcolaEan13 = Null
       Exit Function
    End If
    Dim i As Integer, Summ As Integer, Check As Integer
    Summ = 0
    'somma in posizione pari
    For i = 2 To 12 Step 2
       Summ = Summ + Val(Mid(TestEan, i, 1))
    Next i
    'moltiplica per 3 le cifre in posizione pari
    Summ = Summ * 3
    'somma in posizione dispari
    For i = 1 To 11 Step 2
       Summ = Summ + Val(Mid(TestEan, i, 1))
    Next i
    Summ = Summ Mod 10
    Calcola13 = (10 - Summ) Mod 10
End Function
 
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