Επικύρωση IBAN με συνάρτηση VBA

[Tasos]

Ο παρακάτω κώδικας φροντίζει για την επικύρωση ενός ΙΒΑΝ για 43 διαφορετικές χώρες.

Μπορεί να χρησιμοποιηθεί και μέσα από την Excel: = CheckIBAN(A1)

Μπορείτε να προσθέσετε κωδικούς χωρών και το μήκος του της συμβολοσειράς του IBAN
αφού διευρύνετε τον πίνακα (Array) στη συνάρτηση GetIbanLen().

(-- Για παράδειγμα: Αλάζετε το Land(0 To 43, 0 To 1) σε Land (0 To 50, 0 To 1)
και να προσθέσετε τη γραμμή: Land(43, 0) = "xx": Land(43, 1) = xx --)

Option Explicit



Sub Test_IBAN()

    Dim x As String

    x = "CY17 0020 0128 0000 0012 0052 7600"

    If CheckIBAN(x) Then

        MsgBox "OK"

    Else

        MsgBox "Λάθος!"

    End If

End Sub





Public Function CheckIBAN(ByVal IBAN As String) As Boolean

    Const LDivisor = 97&, iSubtrahend = 55, iPart = 7

    Dim i As Integer, x As Integer, IBANLen As Integer, LMod As Long

    Dim sChr As String, sTMP As String

    IBAN = UCase(Replace(IBAN, " ", ""))

    IBANLen = GetIbanLen(Left(IBAN, 2))

    If IBANLen = 0 Then Exit Function

    For i = 1 To Len(IBAN)

        sChr = Mid(IBAN, i, 1)

        If IsNumeric(sChr) Or (Asc(sChr) > 64 And Asc(sChr) < 91) Then sTMP = sTMP & sChr

    Next

    If Len(sTMP) <> IBANLen Then Exit Function

    IBAN = Mid(sTMP, 5) & Left(sTMP, 4)

    sTMP = vbNullString

    For i = 1 To Len(IBAN)

        If IsNumeric(Mid(IBAN, i, 1)) Then

            sTMP = sTMP & Mid(IBAN, i, 1)

        Else

            sTMP = sTMP & Asc(Mid(IBAN, i, 1)) - iSubtrahend

        End If

    Next

    Do Until Len(sTMP) = 0

        LMod = CLng(LMod & (Mid(sTMP, 1, iPart))) Mod LDivisor

        sTMP = Mid(sTMP, iPart + 1)

    Loop

    CheckIBAN = LMod = 1

End Function



Public Function GetIbanLen(LandCode As String) As Integer

    Dim Land(0 To 42, 0 To 1) As Variant, i As Integer

    Land(0, 0) = "AD": Land(0, 1) = 24: Land(1, 0) = "AT": Land(1, 1) = 20

    Land(2, 0) = "BA": Land(2, 1) = 20: Land(3, 0) = "BE": Land(3, 1) = 16

    Land(4, 0) = "BG": Land(4, 1) = 22: Land(5, 0) = "CH": Land(5, 1) = 21

    Land(6, 0) = "CS": Land(6, 1) = 22: Land(7, 0) = "DE": Land(7, 1) = 22

    Land(8, 0) = "CZ": Land(8, 1) = 24: Land(9, 0) = "DK": Land(9, 1) = 18

    Land(10, 0) = "EE": Land(10, 1) = 20: Land(11, 0) = "ES": Land(11, 1) = 24

    Land(12, 0) = "FI": Land(12, 1) = 18: Land(13, 0) = "FO": Land(13, 1) = 18

    Land(14, 0) = "FR": Land(14, 1) = 27: Land(15, 0) = "GB": Land(15, 1) = 22

    Land(16, 0) = "GI": Land(16, 1) = 23: Land(17, 0) = "GL": Land(17, 1) = 18

    Land(18, 0) = "GR": Land(18, 1) = 27: Land(19, 0) = "HR": Land(19, 1) = 21

    Land(20, 0) = "HU": Land(20, 1) = 28: Land(21, 0) = "IE": Land(21, 1) = 22

    Land(22, 0) = "IS": Land(22, 1) = 26: Land(23, 0) = "IT": Land(23, 1) = 27

    Land(24, 0) = "LI": Land(24, 1) = 21: Land(25, 0) = "LT": Land(25, 1) = 20

    Land(26, 0) = "LU": Land(26, 1) = 20: Land(27, 0) = "LV": Land(27, 1) = 21

    Land(28, 0) = "MC": Land(28, 1) = 27: Land(29, 0) = "MK": Land(29, 1) = 19

    Land(30, 0) = "MT": Land(30, 1) = 31: Land(31, 0) = "NL": Land(31, 1) = 18

    Land(32, 0) = "NO": Land(32, 1) = 15: Land(33, 0) = "PL": Land(33, 1) = 28

    Land(34, 0) = "PT": Land(34, 1) = 25: Land(35, 0) = "RO": Land(35, 1) = 24

    Land(36, 0) = "SE": Land(36, 1) = 24: Land(37, 0) = "SI": Land(37, 1) = 19

    Land(38, 0) = "SK": Land(38, 1) = 24: Land(39, 0) = "SM": Land(39, 1) = 27

    Land(40, 0) = "TN": Land(40, 1) = 24: Land(41, 0) = "TR": Land(41, 1) = 26

    Land(42, 0) = "CY": Land(42, 1) = 28

    For i = 0 To 42

        If Land(i, 0) = LandCode Then

            GetIbanLen = Land(i, 1)

            Exit Function

        End If

    Next

End Function