Abstract
Falls Sie eine Europäische Artikel Nummer (EAN) berechnen oder prüfen müssen:
Siehe auch
Zum Vergleich siehe (externer Link!) Prüfziffer berechnen und testen.
Appendix Programmcode sbEAN
Bitte den Haftungsausschluss im Impressum beachten.
Option Explicit
Function sbEAN(s As String, _
Optional bFullEAN As Boolean = True, _
Optional bEAN14 As Boolean = False) As Variant
'Calculate or check EAN check digit. Works for EAN-8,
'EAN-13, EAN-14 / GTIN, and for EAN-18 / NVE / SSCC.
'If EAN is given without check digit, it is calculated
'and returned (full EAN if bFullEAn is True or just the
'check digit if False). If full EAN is entered the
'result of the check (True or False) will be returned.
'Source (EN): http://www.sulprobil.de/sbean_en/
'Source (DE): http://www.berndplumhoff.de/sbean_de/
'(C) (P) by Bernd Plumhoff 31-Mar-2024 PB V0.3
Dim i As Long, d As Long, m As Long, w As Long
Dim bCheck As Boolean
m = Len(s)
For i = 1 To m
w = Asc(Mid(s, i, 1))
If w < 48 Or w > 57 Then
sbEAN = CVErr(xlErrNum)
Exit Function
End If
Next i
If bEAN14 Then
If m = 13 Then
bCheck = False
ElseIf m = 14 Then
bCheck = True
m = m - 1 'Calculate checksum without check digit
Else
sbEAN = CVErr(xlErrValue)
Exit Function
End If
Else
Select Case m
Case 7, 12, 17
bCheck = False
Case 8, 13, 18
bCheck = True
m = m - 1 'Calculate checksum without check digit
Case Else
sbEAN = CVErr(xlErrValue)
Exit Function
End Select
End If
w = 3
For i = m To 1 Step -1
d = d + Mid(s, i, 1) * w
w = 4 - w 'Alternate between 3 and 1
Next i
d = (10 - d Mod 10) Mod 10
If bCheck Then
sbEAN = Right(s, 1) = d
ElseIf bFullEAN Then
sbEAN = s & d
Else
sbEAN = d
End If
End Function
Download
Bitte den Haftungsausschluss im Impressum beachten.
sbEAN.xlsm [22 KB Excel Datei, ohne jegliche Gewährleistung]