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