'Funkcje testujące poprawnośc wprowadzanych danych
'(c) 2004 J. Byszewski
Option Compare Database
Option Explicit
'Kontrola poprawności NIP
Public Function IsNIP(ByVal NrNIP As String) As Boolean
Dim LK, SK As Long
Dim NIP, Tmp As String
Dim i As Integer
Dim l(9), W(9) As Byte
Dim B As Byte
'Tablica wag
IsNIP = False
On Error GoTo Err_
W(1) = 6: W(2) = 5: W(3) = 7: W(4) = 2: W(5) = 3
W(6) = 4: W(7) = 5: W(8) = 6: W(9) = 7
'Konwersja
Tmp = CStr(NrNIP)
For i = 1 To Len(Tmp)
B = Asc(Mid(Tmp, i, 1))
If B > 47 And B < 57 Then NIP = NIP + Chr(B)
Next i
'Długość NIPu
If Len(NIP) <> 10 Then Exit Function
'Kontrola poprawności
LK = CByte(Val(Right(NIP, 1)))
SK = 0
For i = 1 To 9
l(i) = CByte(Val(Mid(NIP, i, 1)))
SK = SK + l(i) * W(i)
Next
SK = SK Mod 11
If SK = LK Then IsNIP = True
Err_:
End Function
'Kontrola poprawności PESEL
Public Function IsPESEL(ByVal NrPESEL As String) As Boolean
Dim LK, SK As Long
Dim PESEL, Tmp As String
Dim i As Integer
Dim l(10), W(10) As Byte
Dim B As Byte
'Tablica wag
IsPESEL = False
On Error GoTo Err_
W(1) = 1: W(2) = 3: W(3) = 7: W(4) = 9: W(5) = 1
W(6) = 3: W(7) = 7: W(8) = 9: W(9) = 1: W(10) = 3
'Konwersja
Tmp = CStr(NrPESEL)
For i = 1 To Len(Tmp)
B = Asc(Mid(Tmp, i, 1))
If B > 47 And B < 57 Then PESEL = PESEL + Chr(B)
Next i
'Długość PESELu
If Len(PESEL) <> 11 Then Exit Function
'Kontrola poprawności
LK = CByte(Val(Right(PESEL, 1)))
SK = 0
For i = 1 To 10
l(i) = CByte(Val(Mid(PESEL, i, 1)))
SK = SK + l(i) * W(i)
Next
SK = (10 - (SK Mod 10)) Mod 10
If SK = LK Then IsPESEL = True
Err_:
End Function
'Kontrola poprawności REGON
Public Function IsREGON(ByVal NrREGON As Variant) As Boolean
Dim LK, SK As Long
Dim REGON, Tmp As String
Dim i As Integer
Dim l(8), W(8) As Byte
Dim B As Byte
'Tablica wag
IsREGON = False
On Error GoTo Err_
W(1) = 8: W(2) = 9: W(3) = 2: W(4) = 3
W(5) = 4: W(6) = 5: W(7) = 6: W(8) = 7
'Konwersja
Tmp = CStr(NrREGON)
For i = 1 To Len(Tmp)
B = Asc(Mid(Tmp, i, 1))
If B > 47 And B < 57 Then REGON = REGON + Chr(B)
Next i
'Długość PESELu
If Len(REGON) <> 9 Then Exit Function
'Kontrola poprawności
LK = CByte(Val(Right(REGON, 1)))
SK = 0
For i = 1 To 8
l(i) = CByte(Val(Mid(REGON, i, 1)))
SK = SK + l(i) * W(i)
Next
SK = (SK Mod 11) Mod 10
If SK = LK Then IsREGON = True
Err_:
End Function
Na koniec zamieszczam uwagę, którą przysłał zbiniek@go2.pl:
Witam!