Forum społeczności użytkowników OpenOffice i LibreOffice

Kod: Zaznacz cały

Function PESEL_OK(pesel As String) As Boolean
	Dim i%, i2%, cyfra%, suma%, wagi (10) as Integer
	If Len(pesel) = 11 Then
		wagi = Array(1, 3, 7, 9, 1, 3, 7, 9, 1, 3, 1)
		suma=0
		i2=1
		For i = LBound(wagi) To UBound(wagi)
			cyfra=Mid(pesel, i2, 1)
			suma=suma+(cyfra*wagi(i))
			i2=i2+1
		Next
		PESEL_OK=(suma MOD 10) = 0
	Else
		PESEL_OK=False
	End If
End Function

Function PESEL_DATA(pesel As String) As Date
	On Error GoTo ErrorHandler
	Dim stulecie%, rok%, miesiac%, dzien%, rok2%
	rok=Mid(pesel, 1, 2)
	miesiac=Mid(pesel, 3, 2)
	dzien=Mid(pesel, 5, 2)
	stulecie=1
	While miesiac > 20
		miesiac=miesiac-20
		stulecie=stulecie+1
	Wend
	rok2=Choose(stulecie, 1900, 2000, 2100, 2200, 1800)
	If miesiac = 0 Then miesiac=1
	If dzien = 0 Then dzien=1
	PESEL_DATA=DateSerial(rok+rok2, miesiac, dzien)
	Exit Function
ErrorHandler:
	PESEL_DATA=DateSerial(0, 1, 1)
End Function

Function PESEL_K(pesel As String) As Boolean
	Dim cyfra%
	cyfra=Mid(pesel, 10, 1)
	PESEL_K=(cyfra MOD 2) = 0
End Function

Function PESEL_M(pesel As String) As Boolean
	PESEL_M=Not PESEL_K(pesel)
End Function

Function PESEL_PLEC(pesel As String) As String
	If PESEL_K(pesel) Then PESEL_PLEC="K" Else PESEL_PLEC="M"
End Function

Kod: Zaznacz cały

	If Len(pesel) = 11 Then

Kod: Zaznacz cały

	If miesiac = 0 Then miesiac=1
	If dzien = 0 Then dzien=1

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