30. Funkcja do sprawdzania poprawności sumy kontrolnej w kodach kreskowych.
Rozwiązanie podał Wojciech Wendrychowicz:
Cześć,
Funkcja VBA do sprawdzania poprawności sumy kontrolnej w kodach kreskowych typu
Interleaved Two of Five.
Funkcję można oczywiście też łatwo przerobić, aby zwracała samą sumę kontroną (np.
przy wydruku kodów kreskowych).
Pozdrawiam,
Wojtek
Public Function
ITFchecksum(sBarcode As String
) As Boolean
'
============================================================
'
Funkcja bada, czy cyfra kontrolna w podanym kodzie kreskowym
' jest
poprawna i zależnie od tego zwraca TRUE albo FALSE
' (c)
Wojciech Wendrychowicz
'
W dot WENDRYCHOWICZ at GMAIL dot COM
'
============================================================
Dim
iOrigChecksum As Integer
'Oryginalna suma kontrolna z kodu kreskowego
Dim iChecksum
As Integer 'Własna
suma kontrolna, którą zaraz wyliczymy
'do porównania
Dim i, j, iWaga
As Integer
'Zmienne do pętli i wag
iOrigChecksum = Right(Trim(sBarcode), 1)
sBarcode = Mid(sBarcode, 1,
Len(Trim(sBarcode)) - 1)
j = 0
i = Len(sBarcode)
Do Until i = 0
If j
Mod 2 = 0
Then iWaga = 3
Else iWaga = 1
' przypisanie naprzemiennie wag 1 i 3
zaczynając od końca
iChecksum = iChecksum + CInt(Mid(sBarcode, i, 1)) * iWaga
' pomnożenie przez wagi
i = i - 1
j = j + 1
Loop
iChecksum = Right(10 - iChecksum Mod 10, 1)
If iOrigChecksum
= iChecksum Then
ITFchecksum =
True Else ITFchecksum =
False
End
Function