Codice EAN13

[Stefano]

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

[BFS]

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

[Stefano]

Grazie mille, lo provo subito.

[Stefano]

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

[@Alex]

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

[BFS]

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

[BFS]

Il 26/08/2019 16:02, Stefano ha scritto:

con il tuo esempio otterresti questo
https://ibb.co/b5qfHBq

ciao

[Stefano]

Il 26/08/2019 16:19, BFS ha scritto:

[cut]

>> 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
>
>
> con il tuo esempio otterresti questo
> https://ibb.co/b5qfHBq
>
> 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.

[Stefano]

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