General

6.26 Controllo check digit di codici a barre EAN-8 e EAN-13.
  AntoGal
Public Function TestChecksumEan13(TestEan As String) As Boolean
   'Autore: AntoGal
   'Accetta: TestEan = codice EAN-13
   'Restituisce: true se il codice è corretto
   If Not TestEan Like "#############" Then 'controlla che siano 13 cifre
      TestChecksumEan13 = False
      Exit Function
   End If
   Dim i As Integer, Sum As Integer, Check As Integer
   Sum = 0
   'somma in posizione pari
   For i = 2 To 12 Step 2
      Sum = Sum + Val(Mid(TestEan, i, 1))
   Next i
   'moltiplica per 3 le cifre in posizione pari
   Sum = Sum * 3
   'somma in posizione dispari
   For i = 1 To 11 Step 2
      Sum = Sum + Val(Mid(TestEan, i, 1))
   Next i
   Sum = Sum Mod 10
   Check = (10 - Sum) Mod 10
   If Val(Right(TestEan, 1)) = Check Then
      TestChecksumEan13 = True 'codice corretto
   Else
      TestChecksumEan13 = False 'codice errato
   End If
End Function

Public Function TestChecksumEan8(TestEan As String) As Boolean
   'Autore: AntoGal
   'Accetta: TestEan = codice EAN-8
   'Restituisce: true se il codice è corretto
   If Not TestEan Like "########" Then 'controlla che siano 8 cifre
      TestChecksumEan8 = False
      Exit Function
   End If
   Dim i As Integer, Sum As Integer, Check As Integer
   Sum = 0
   'somma in posizione dispari
   For i = 1 To 7 Step 2
      Sum = Sum + Val(Mid(TestEan, i, 1))
   Next i
   'moltiplica per 3 le cifre in posizione dispari
   Sum = Sum * 3
   'somma in posizione pari
   For i = 2 To 6 Step 2
      Sum = Sum + Val(Mid(TestEan, i, 1))
   Next i
   Sum = Sum Mod 10
   Check = (10 - Sum) Mod 10
   If Val(Right(TestEan, 1)) = Check Then
      TestChecksumEan8 = True 'codice corretto
   Else
      TestChecksumEan8 = False 'codice errato
   End If
End Function


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.