Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Access > Access - Tips & Tricks > Επικύρωση IBAN με συνάρτηση VBA

Access - Tips & Tricks Εκμεταλλευτείτε τις δυνατότητες της Microsoft Access.
Παρακαλούμε μην εισάγετε εδώ ερωτήσεις!

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 03-10-11, 09:23
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 1.328
Προεπιλογή Επικύρωση IBAN με συνάρτηση VBA

Ο παρακάτω κώδικας φροντίζει για την επικύρωση ενός ΙΒΑΝ για 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
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών σε VB.Net, Access, Excel, Outlook, Word

Τελευταία επεξεργασία από το χρήστη Tasos : 03-10-11 στις 20:52. Αιτία: Διόρθωση σύνταξης κώδικα ( πρόβλημα εμφάνισης HTML)
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι σε λειτουργία
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
Account Validator Επικύρωση ΑΜΚΑ, IBAN, ΑΦΜ Tasos Τα Νέα του Ms-Office.gr 0 08-10-11 00:56
Επικύρωση ΑΜΚΑ σε Excel Tasos Άλλες συναρτήσεις 0 05-10-11 18:24
Επικύρωση IBAN σε Excel Chris Excel samples - Χρήσιμα αρχεία & παραδείγματα 0 03-10-11 21:58
[Γενικά] Δυναμική αλλά όχι υποχρεωτική επικύρωση. gr8styl Excel - Tips & Tricks 0 11-12-10 00:56
Access - Επαλήθευση επικύρωση ΑΦΜ Tasos Access - Tips & Tricks 0 08-02-10 18:25


Η ώρα είναι 11:21.