Ostatnio w dziale Base był poruszony temat sprawdzenia poprawności numeru pesel w formularzu
(zobaczysz go tutaj), wczytałem się w ten problem i mam uwagi odnośnie kodu pozostawionego przez @Tithen-Firion:
Test czy pesel składa się z 11 znaków, można by jeszcze sprawdzić czy składa się on wyłącznie z cyfr.
Kod: Zaznacz cały
If miesiac = 0 Then miesiac=1
If dzien = 0 Then dzien=1
Jeśli miesiąc lub dzień według pesla wynosi zero to dokonuje podmiany na wartość 1. Uważam, że tutaj powinien być komunikat o błędnym numerze.
Poprawiłem makro przedstawione w dziale BASE i jeśli ktoś chce może użyć tej funkcji:
Kod: Zaznacz cały
Function Sprawdz_Pesel(optional Nr_PESEL As Variant, optional Opcja As Byte)As Variant
' Funkcja zwraca wartość Null jeżeli Nr_PESEL jest pusty
' W zależności od wartości drugiego parametru funkcja zwraca:
' 0 lub brak - wszystkie poniższe wartości (!formuła macierzowa w CALC)
' 1 - True lub False poprawności PESELa
' 2 - datę urodzenia danej osoby lub null jeśli pesel jest błędny
' 3 - płeć osoby (K dla kobiety, M dla mężczyzny) lub null jeśli pesel jest błędny
' 4 - komentarz tekstowy o dostarczonym numerze
If IsMissing(Nr_PESEL) Or Len(Nr_PESEL) = 0 Then
Sprawdz_Pesel = Null
Exit Function
elseIf IsMissing(Opcja) then
Opcja = 0
End If
Dim Waga() As Byte 'waga jest używana do weryfikacji prawidłowości numeru PESEL
Waga = Array(1,3,7,9,1,3,7,9,1,3,1)
Dim lata() as byte 'pierwsze dwie cyfry roku
lata = Array(19,20,21,22,18)
Dim Sumakontrolna As Integer, i As Integer, rok as Integer
Dim mies as Byte, dzien as Byte, iledni As Byte
Dim Cyfrakontrolna As string
Dim wynik(3) as variant
wynik(0) = false
wynik(3) = "Podany numer nie jest Peslem"
If Len(Nr_PESEL) <> 11 or Not IsNumeric(Nr_PESEL) Then
If IsNumeric(Nr_PESEL) Then
wynik(3) = "Numer PESEL składa się z 11 cyfr."
Else
wynik(3) = "Używaj tylko cyfr. Numer PESEL składa się z 11 cyfr."
EndIf
else
i = val(Mid(Nr_PESEL,3,1))\2 'dzielenie całkowite
rok = lata(i) & Left(Nr_PESEL,2) 'rok urodzin
mies = val(Mid(Nr_PESEL,3,2))-i*20 'miesiąc urodzin
dzien = Mid(Nr_PESEL,5,2) 'dzień urodzin
select case mies 'ile dany miesiąc ma dni
case 1,3,5,7,8,10,12 : iledni = 31 'te miesiące maja 31 dni
case 4,6,9,11 : iledni = 30
case 2
if ((rok mod 4)=0 and (rok mod 100)<>0) or (rok mod 400) = 0 then 'czy rok przestępny
iledni = 29
else iledni = 28
endif
case else 'obliczona wartość mies jest spoza przedziału (1...12)
iledni = 0 'miesiąc jest błędny
end select
'kontrola daty
if dzien=0 or dzien>iledni then 'jeśli data jest błędna (nieistniejący miesiąc lub dzień)
wynik(3) = "Błędna sekwencja cyfr odpowiadających dacie"
elseif DateSerial(rok, mies, dzien) > Date then 'kontrola urodzenia; czy data ur. > dziś
wynik(3) = "Według podanego numeru ta osoba jeszcze się nie urodziła."
else 'gdy data jest poprawna
Sumakontrolna = 0
for i=1 to 10
Sumakontrolna = Sumakontrolna + val(Mid(Nr_PESEL, i, 1)) * Waga(i-1)
next i
Cyfrakontrolna = Right(10 - (Sumakontrolna Mod 10), 1)
if Right(Nr_PESEL,1) = Cyfrakontrolna then
wynik(0) = true
wynik(1) = DateSerial(rok, mies, dzien)
wynik(2) = iif((val(Mid(Nr_PESEL, 10, 1)) mod 2) , "M" , "K")
wynik(3) = "Podany numer jest Peslem"
end if
endif
Endif
'Wypisanie wynikówów
select case Opcja
case 0 'zwróci wszystkie wyniki (użyj formuły macierzowej w CALC)
Sprawdz_Pesel = wynik
case 1, 4 'ma zwrócić informację o poprawności PESELa (logiczną lub tekstową)
Sprawdz_Pesel = wynik(Opcja-1)
case 2, 3 'te wyniki ma podać tylko w przypadku prawidłowego pesla
if wynik(0) = false then
Sprawdz_Pesel = null
else '2 zwraca datę urodzenia, 3 informację o płci
Sprawdz_Pesel = wynik(Opcja-1)
endif
case else 'jeśli podano błędny parametr
Sprawdz_Pesel = "Wpisano błędny opcjonalny parametr funkcji, spodziewana wartość to 0,1,2,3 lub brak."
end select
End Function
Jak widać jest ona zgodna z sugestią:
Jermor pisze:
Może, zamiast kilku funkcji, utworzyć jedną, z drugim parametrem określającym, jaka wartość ma zostać zwrócona.
LibreOffice 7.4.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
