PESEL - makro

Gotowe szablony, skrypty, makropolecenia i rozszerzenia. Tutaj możesz pochwalić i podzielić się swoją twórczością z innymi użytkownikami

PESEL - makro

Postprzez Tithen-Firion » N kwi 11, 2021 2:00 pm

Napisałem kilka funkcji, może komuś się przyda.

PESEL_OK - sprawdza czy podany PESEL jest poprawny
(funkcje poniżej nie sprawdzają poprawności PESELu!)
PESEL_DATA - zwraca datę urodzenia z podanego numeru PESEL
PESEL_PLEC - zwraca płeć, K (kobieta) albo M (mężczyzna)
PESEL_K - zwraca prawdę jeśli pesel należy do kobiety
PESEL_M - zwraca prawdę jeśli pesel należy do mężczyzny

Żeby je dodać do arkusza wybierz:
Narzędzia > Makra > Zarządzaj makrami > Basic
Wybierz swój plik, kliknij "Nowy", "OK", zastąp tekst kodem poniżej, zapisz makro (Plik > Zapisz) i zamknij okno.

Kod: Zaznacz cały   Rozszerz widokZwiń widok
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
LibreOffice 6.4 na Windows 10
Tithen-Firion
 
Posty: 1
Dołączył(a): N kwi 11, 2021 1:41 pm

Re: PESEL - makro

Postprzez Jermor » So cze 05, 2021 2:20 pm

Tak jak napisałeś, może się komuś przydadzą. Chciałbym jednak zwrócić ci uwagę na sposób budowania makr, ze względu na ich przeznaczenie. Napisałem o tym nieco w tym opracowaniu https://yestok.pl/lbo/y61.php (akurat kod PESEL-u wykorzystałem jako przykład).
O ile w pierwszej zacytowanej funkcji sprawdzasz długość kodu, to nie robisz tego już w następnych makrach. Jeśli więc użytkownik pomyli się i wpisze krótszy kod, to np. funkcje dotyczące płci nie wykonają się poprawnie.
Ponadto wydaje mi się, że powinieneś jednak kontrolować czy to, co wpisał użytkownik, jako argument funkcji, może zostać uznane za PESEL.
Może, zamiast kilku funkcji, utworzyć jedną, z drugim parametrem określającym, jaka wartość ma zostać zwrócona.
AOO 4.1.10, LO 7.1.5 (x64) na Windows 10 64bit
Ważne!
Jeśli twój problem został rozwiązany, wróć do swojego pierwszego postu, przejdź do edycji i dopisz [SOLVED] w temacie.
Inni, którzy mają podobny problem, będą wiedzieli, że istnieje jego rozwiązanie.
Avatar użytkownika
Jermor
 
Posty: 1544
Dołączył(a): So paź 12, 2013 11:09 am


Powrót do Projekty użytkowników

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników i 1 gość