Radau cia toki pvz savajam archyve:
Public Function isValidKodas(akodas As String, arpoz As String) As Boolean
Dim sumx, sumx2, i As Long
If arpoz = "1" And Len(akodas) <> 11 Then
isValidKodas = False
'MsgBox "Neteisingas asmens kodo simbolių skaičius." + Chr(13) +
Chr(10) + "Turi būti 11 simbolių.", vbOKOnly + vbExclamation, "Taisykite"
Exit Function
End If
If Not (IsNumeric(Mid(akodas, 1, 1)) And IsNumeric(Mid(akodas, 2, 1)))
Then
isValidKodas = False
'MsgBox "Neteisingas asmens/rejestro kodas.", vbOKOnly +
vbExclamation, "Taisykite"
Exit Function
End If
If arpoz = "1" Then
Dim strstr, Metai, menuo, diena As String
Select Case Left(akodas, 1)
Case "1"
Metai = "18"
Case "2"
Metai = "18"
Case "3"
Metai = "19"
Case "4"
Metai = "19"
Case "5"
Metai = "20"
Case "6"
Metai = "20"
Case Else
isValidKodas = False
'MsgBox "Neteisingas a/k pirmas skaitmuo." + Chr(13) +
Chr(10) + "Turi būti tarp 1 ir 6", vbOKOnly + vbExclamation, "Taisykite"
Exit Function
End Select
Metai = Metai + Mid(akodas, 2, 2)
menuo = Mid(akodas, 4, 2)
diena = Mid(akodas, 6, 2)
If menuo <> "00" And diena <> "00" Then
On Error GoTo ErrorHandler
DateValue (Metai + "." + menuo + "." + diena)
On Error GoTo 0
End If
Const strg1 = "1234567891"
Const strg2 = "3456789123"
sumx = 0
For i = 1 To 10
sumx = sumx + Val(Mid(akodas, i, 1)) * Val(Mid(strg1, i, 1))
Next i
sumx = sumx Mod 11
If sumx = 10 Then
sumx = 0
For i = 1 To 10
sumx = sumx + Val(Mid(akodas, i, 1)) * Val(Mid(strg2, i, 1))
Next i
sumx = sumx Mod 11
sumx = IIf(sumx = 10, 0, sumx)
End If
If sumx <> Val(Mid(akodas, 11, 1)) Then
isValidKodas = False
'MsgBox "Neteisingas a/k apsauginis skaitmuo.", vbOKOnly +
vbExclamation, "Taisykite"
Exit Function
End If
End If
If arpoz = "2" Then
If Len(akodas) <> 7 Then
isValidKodas = True
Exit Function
End If
sumx = 0
For i = 1 To 6
sumx = sumx + Val(Mid(akodas, i, 1)) * i
Next i
sumx = sumx Mod 11
sumx2 = 11 - sumx
If (sumx2 < 1 Or sumx2 > 9) Or Val(Mid(akodas, 7, 1)) <> sumx2 Then
'MsgBox "Neteisingas r/k paskutinis skaitmuo: " + Mid(KODAS,
7,1) + Chr(13) + Chr(10) + "Turi b?ti: " + str(sumx2), vbOKOnly
+vbExclamation , "Taisykite"
isValidKodas = False
'MsgBox "Neteisingas r/k apsauginis skaitmuo.", vbOKOnly +
vbExclamation, "Taisykite"
Exit Function
End If
End If
isValidKodas = True
Exit Function
ErrorHandler:
'MsgBox "Neteisinga data ", vbOKOnly + vbExclamation, "Taisykite"
isValidKodas = False
Exit Function
End Function
"Joint_as" <a@a.com> wrote in message
news:hi1pkb$6o0$1@trimpas.omnitel.net...
> Asmens kodo validation rule MS Access'e ??
>