Funkcje daty i czasu

02.10.2020

Nazwa dnia tygodnia

Prosta funkcja pozwoli nam określić nazwę dnia tygodnia w języku polskim dla argumentu typu data.

Function DzienTygodnia(Dzien as Date) as String
    'funkcja zwraca nazwę dnia tygodnia
    Dim aNazwy() 'deklaracja pustej tablicy
    'funkcja Array() tworzy tablicę typu Variant i numeruje elementy od 0
    aNazwy = Array("niedziela", "poniedziałek", "wtorek", "środa", "czwartek", "piątek", "sobota")
    DzienTygodnia = aNazwy( Weekday(Dzien) - 1 )
End Function

Sub DataCzas1()
    MsgBox DzienTygodnia( DateSerial(2000, 1, 1) ) 'sobota
    MsgBox DzienTygodnia( Date() ) 'dzisiejszy dzień tygodnia
End Sub

Liczba dni w miesiącu

Równie prosta funkcja pozwala określić liczbę dni w określonym miesiącu. Oczywiście musimy również podać rok ze względu na lata przestępne.

Function MonthDays(myYear as Long, myMonth as Long) as Long
    'znajduje liczbę dni w miesiącu danego roku
    If myMonth = 12 Then
        MonthDays = 31
    Else
        MonthDays = Day( DateSerial(myYear, myMonth + 1, 1) - 1 )
    End If
End Function

Sub DataCzas2()
    MsgBox MonthDays(1900, 2)
    MsgBox MonthDays(2000, 2)
    MsgBox MonthDays(2100, 2)
End Sub

Wyznaczanie daty Wielkanocy

Wyznaczenie daty Wielkanocy nie jest rzeczą prostą. LibreOffice ma wbudowaną funkcję arkusza EASTERSUNDAY(), która podaje prawidłową datę Wielkanocy dla lat 1583 – 9956 (dla lat większych od 9956 występuje błąd). Funkcje arkusza mogą być wykorzystywane w makrach, ale nie możemy tego uczynić bezpośrednio. Funkcja myWielkanoc() pokazuje nam jak uzyskać dostęp do funkcji arkusza w makrach. Podajemy też prostą funkcję EasterDate(), która wyznacza prawidłowe daty Wielkanocy dla lat 1900 – 2099 (LINK). Inne algorytmy Czytelnik znajdzie na stronie Wikipedii (LINK).

Function myWielkanoc(Rok as Long) as Date 'LINK
    'oblicza datę Wielkanocy dla lat 1583 – 9956
    Dim oFuncAcc as Object
    oFuncAcc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
    myWielkanoc = oFuncAcc.callFunction( "EASTERSUNDAY", Array(Rok) )
End Function

Function EasterDate(Rok As Long) as Date 'LINK
    'oblicza datę Wielkanocy dla lat 1900 – 2099
    Dim N as Long
    N = (((255 - 11 * (Rok MOD 19)) - 21) MOD 30) + 21
    EasterDate = DateSerial(Rok, 3, 1) + N + (N > 48) + 6 - ((Rok + Int(Rok/4) + N + (N > 48) + 1) MOD 7)
End Function

Sub DataCzas3()
    Dim n as Long
    For n = 1895 To 2105
        If myWielkanoc(n) <> EasterDate(n) Then MsgBox n
    Next n
End Sub

Wielkanoc jest świętem ruchomym. Najwcześniej wypada 22 marca, zaś najpóźniej 25 kwietnia (LINK). Korzystając z funkcji myWielkanoc() łatwo znajdujemy, że w okresie do roku 2500 Wielkanoc wypada:
22 marca w latach: 1598, 1693, 1761, 1818, 2285, 2353, 2437
25 kwietnia w latach: 1666, 1734, 1886, 1943, 2038, 2190, 2258, 2326, 2410

Do obliczeń wykorzystujemy następującą procedurę, która zapisuje uzyskane wyniki do pliku:

Sub Wielkanoc_daty_skrajne()
    Dim DataWielkanocy as Date
    Dim FileNumber as Long, n as Long
    Dim FileName as String
    FileNumber = Freefile()
    FileName = "c:/data.txt" 'podaj właściwą ścieżkę do pliku!
    If FileExists(FileName) Then Kill(FileName) 'kasujemy plik, jeżeli taki istnieje
    
    Open FileName For Binary As #FileNumber 'otwarcie pliku
    Put #FileNumber,, "Wielkanoc w dniu 22 marca wypada w latach:" & Chr(10)
    For n = 1583 To 2500
        DataWielkanocy = myWielkanoc(n)
        If Month(DataWielkanocy) = 3 AND Day(DataWielkanocy) = 22 Then
            Put #FileNumber,, CStr( Year(DataWielkanocy) ) & ", "
        End If
    Next n
    Put #FileNumber,, Chr(10) & "Wielkanoc w dniu 25 kwietnia wypada w latach:" & Chr(10)
    For n = 1583 To 2500
        DataWielkanocy = myWielkanoc(n)
        If Month(DataWielkanocy) = 4 AND Day(DataWielkanocy) = 25 Then
            Put #FileNumber,, CStr( Year(DataWielkanocy) ) & ", "
        End If
    Next n
    Close #FileNumber 'zamknięcie pliku
    MsgBox "Koniec"
End Sub

Czy dany dzień jest dniem ustawowo wolnym od pracy

W Polsce mamy trzynaście dni ustawowo wolnych od pracy, z których dwa (Wielkanoc i Zesłanie Ducha Świętego) zawsze wypadają w niedzielę. Poniższa funkcja sprawdza, czy badany dzień jest jednym z dni ustawowo wolnych od pracy. Uwaga: funkcja korzysta ze zdefiniowanej wyżej funkcji EasterDate().

Function CzySwieto(RRRR as Long, MM as Long, DD as Long) as Boolean
    'sprawdza czy podany dzień jest dniem ustwowo wolnym od pracy dla lat 1900 – 2099
    Dim DniWolne(1 To 13) as Date
    Dim DataWielkanocy as Date, Dzien as Date
    Dim n as Long
    
    DataWielkanocy = EasterDate(RRRR) 'funkcja EasterDate() oblicza prawidłową datę Wielkanocy tylko dla lat 1900 – 2099
    DniWolne(1) = DateSerial(RRRR, 1, 1) 'Nowy Rok
    DniWolne(2) = DateSerial(RRRR, 1, 6) 'Święto Trzech Króli
    DniWolne(3) = DataWielkanocy 'Wielkanoc
    DniWolne(4) = DataWielkanocy + 1 'Poniedziałek Wielkanocny
    DniWolne(5) = DataWielkanocy + 49 'Zesłanie Ducha Świętego (Zielone Świątki)
    DniWolne(6) = DataWielkanocy + 60 'Boże Ciało
    DniWolne(7) = DateSerial(RRRR, 5, 1) 'Święto Pracy
    DniWolne(8) = DateSerial(RRRR, 5, 3) 'Święto Konstytucji 3 Maja
    DniWolne(9) = DateSerial(RRRR, 8, 15) 'Wniebowzięcie Najświętszej Maryi Panny
    DniWolne(10) = DateSerial(RRRR, 11, 1) 'Wszystkich Świętych
    DniWolne(11) = DateSerial(RRRR, 11, 11) 'Narodowe Święto Niepodległości 
    DniWolne(12) = DateSerial(RRRR, 12, 25) 'Boże Narodzenie
    DniWolne(13) = DateSerial(RRRR, 12, 26) 'drugi dzień Świąt Bożego Narodzenia
    
    CzySwieto = False
    Dzien = DateSerial(RRRR, MM, DD)
    For n = 1 To 13
        If Dzien = DniWolne(n) Then
            CzySwieto = True
            Exit For
        End If
    Next n
End Function

Sub DataCzas4()
    MsgBox CzySwieto(2000, 5, 1)
    MsgBox CzySwieto(2020, 4, 12)
End Sub

Wyznaczanie daty Wielkanocy (uzupełnienie)

Przedstawimy niżej funkcję znajdującą datę Wielkanocy dla dowolnego roku nie mniejszego niż 1583. Korzystamy z algorytmu podanego w książce Jeana Meeusa Astronomical Algorithms na stronie 67. Musimy być bardzo ostrożni przy wyznaczaniu części całkowitej ilorazu i reszty z dzielenia dwóch liczb. Funkcja Int() zwraca część całkowitą liczby, ale zwracana jest liczba typu Double. Operacja obliczania reszty z dzielenia też jest dostępna w LibreOffice, ale dopuszcza nietypowe argumenty (np. 11 MOD 2.5 jest równe 1). Dlatego zdefiniowaliśmy własne funkcje Quotient() i Remainder(), które znajdują część całkowitą ilorazu i resztę z dzielenia. Zapisanie algorytmu nie przedstawia większych trudności. Czytelnik łatwo sprawdzi zgodność tej funkcji z funkcją EASTERSUNDAY() dla lat 1583 – 9956.

Function Quotient(N as Long, D as Long) as Long
    'oblicza część całowitą ilorazu liczb całkowitych N i D
    Quotient = CLng( Int(N/D) ) 'funkcja Int zwraca liczbę typu Double
End Function

Function Remainder(N as Long, D as Long) as Long
    'oblicza resztę z dzielenia liczb całkowitych N i D
    Remainder = N - CLng( Int(N/D) ) * D
End Function

Function DataWielkanocy(Year as Long) as Date
    'oblicza datę Wielkanocy dla lat nie mniejszych niż 1583
    Dim a as Long, b as Long, c as Long, d as Long, e as Long
    Dim f as Long, g as Long, h as Long, i as Long
    Dim k as Long, l as Long, m as Long, n as Long, p as Long
    a = Remainder(Year, 19)
    b = Quotient(Year, 100)
    c = Remainder(Year, 100)
    d = Quotient(b, 4)
    e = Remainder(b, 4)
    f = Quotient(b + 8, 25)
    g = Quotient(b - f + 1, 3)
    h = Remainder(19*a + b - d - g + 15, 30)
    i = Quotient(c, 4)
    k = Remainder(c, 4)
    l = Remainder(2*e + 2*i - h - k + 32, 7)
    m = Quotient(a + 11*h + 22*l, 451)
    n = Quotient(h + l - 7*m + 114, 31)
    p = Remainder(h + l - 7*m + 114, 31)
    DataWielkanocy = DateSerial(Year, n, p + 1)
End Function

Sub DataCzas5()
    MsgBox DataWielkanocy(10000) '16.04.10000
    MsgBox DataWielkanocy(15000) '06.04.15000
    MsgBox DataWielkanocy(20000) '23.04.20000
End Sub

LibreOffice Calc – makra                   Strona główna