Terminarz

Z Henryk Dąbrowski
Przejdź do nawigacji Przejdź do wyszukiwania
08.06.2021




Przedstawiamy niżej prosty, ale z pewnością użyteczny kod, który pozwoli użytkownikowi stworzyć terminarz obejmujący powtarzające się zadania oraz wydarzenia wypadające w ustalonych dniach roku. Kod składa się z pięciu podprogramów: funkcji MonthDays() i DzienTygodnia() oraz procedury RangeBorder() – te podprogramy zostały zdefiniowane wcześniej i Czytelnik może się z nimi łatwo zapoznać. Dodatkowo mamy procedurę główną Terminarz(), która określa, jak będzie budowany nasz terminarz i procedurę pomocniczą CellFormat(), która określa, jak zostanie sformatowana komórka, do której wpisujemy dane.


Wydarzenia wypadające w określonych dniach roku zostały zebrane w arkuszu o ustalonej nazwie „Dni” i nazwy tej nie należy zmieniać bez wprowadzenia odpowiedniej zmiany w kodzie procedury Terminarz(). Daty w kolumnie A arkusza „Dni", to kolejne dni dowolnego roku przestępnego. W kolumnie B wpisujemy tekst opisujący wydarzenie związane z określonym dniem miesiąca. Dla przykładu w kolumnie B zostały wpisane popularne imieniny i niektóre święta. Dane z arkusza „Dni” zostaną wpisane w tworzonym przez nas terminarzu w kolumnie F.


Przed uruchomieniem procedury Terminarz() musimy ustalić i wpisać do jej kodu wartości trzech zmiennych: Start, Koniec oraz k. Zmienna Start (typu Date) określa pierwszy dzień od którego zacznie się budowanie terminarza, zaś zmienna k (typu Long) określa indeks wiersza, od którego rozpocznie się budowanie terminarza i do którego zostanie wpisana wartość zmiennej Start. Zmienna Koniec (typu Date) określa ostatni dzień, który zostanie uwzględniony w tworzonym terminarzu. Należy pamiętać, że terminarz zostanie utworzony w pierwszym arkuszu naszego skoroszytu, zatem skoroszyt poza arkuszem „Dni” musi mieć przynajmniej jeden dodatkowy arkusz.


Powtarzające się terminy można podzielić na takie, które wypadają w określonym dniu miesiąca i na takie, które wypadają w określonym dniu tygodnia. Sposoby badania, czy w danym dniu wypadają interesujące nas terminy, zostały pokazane w przykładowym kodzie procedury Terminarz(). Zdefiniowane przez nas terminy zostaną wpisane w utworzonym terminarzu w kolumnie D.


Link do skoroszytu Terminarz.ods

Sub Terminarz()
    Dim Licz as Long, wiersz as Long, k as Long, t as Long, MonthEnd as Long
    Dim notatka as String
    Dim d as Date, Start as Date, Koniec as Date
    Dim oShtDni as Object, oSht as Object, oColumns as Object, oRow as Object, oCllA as Object, oCllB as Object
    oShtDni = ThisComponent.getSheets().getByName("Dni") 'uchwyt do arkusza o nazwie "Dni"
    oSht = ThisComponent.getSheets.getByIndex(0) 'uchwyt do pierwszego arkusza
    ThisComponent.CurrentController.setActiveSheet(oSht) 'aktywacja pierwszego arkusza
    Start = DateSerial(2021, 1, 1) 'początek terminarza
    Koniec = DateSerial(2021, 12, 31) 'koniec terminarza
    k = 0 'UWAGA: k odpowiada indeksowi wiersza z datą Start
    d = Start
    Do While d <= Koniec
        Licz = 0 'zmienna Licz zlicza, ile wykonano wpisów pod tą samą datą w kolumnie D
        t = Weekday(d) 'niedziela-1, sobota-7
        MonthEnd = MonthDays( Year(d), Month(d) )
        oRow = oSht.getRows().getByIndex(k) 'uchwyt do wiersza o indeksie k
        oCllA = oSht.getCellByPosition(0, k) 'uchwyt do komórki A wiersza o indeksie k
        oCllB = oSht.getCellByPosition(1, k) 'uchwyt do komórki B wiersza o indeksie k
        oCllA.Value = d
        'formatowanie komórki A:
        oCllA.NumberFormat = 36 'format daty: 31.12.1999
        oCllA.VertJustify = com.sun.star.table.CellVertJustify.CENTER 'wyśrodkowanie tekstu w pionie
    
        oCllB.String = DzienTygodnia(d)
        'formatowanie komórki B:
        oCllB.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER 'wyśrodkowanie tekstu w poziomie
        oCllB.VertJustify = com.sun.star.table.CellVertJustify.CENTER 'wyśrodkowanie tekstu w pionie
    
        If t = 1 Then 'niedziela
            oRow.CellBackColor = RGB(255, 0, 0) 'czerwony kolor tła wiersza
        End If
    
    'Informacja dotycząca wybranych dni roku z arkusza "Dni" (wpis w kolumnie F)
        wiersz = DateSerial(2000, Month(d), Day(d)) - 36526 'indeks wiersza w arkuszu "Dni" z notatką odpowiadającą dacie d
        notatka = oShtDni.getCellByPosition(1, wiersz).String
        If notatka <> "" Then
            Call CellFormat( oSht.getCellByPosition(5, k), notatka, RGB(204, 255, 204) )
        End If
    
    'Powtarzające się terminy - dotyczące dni miesiąca (wpis w kolumnie D)
    
        If Day(d) = 7 Then
            Call CellFormat( oSht.getCellByPosition(3, k + Licz), "Siódmy dzień miesiąca", RGB(153, 204, 255) )
            Licz = Licz + 1
        End If
    
    'Powtarzające się terminy - dotyczące dni tygodnia (wpis w kolumnie D)
    
        'czwartek co dwa tygodnie począwszy od 07.01.2021
        If t = 5 AND (d - DateSerial(2021, 1, 7)) Mod 14 = 0 Then
            Call CellFormat( oSht.getCellByPosition(3, k + Licz), "Spotkanie w czwartek (co dwa tygodnie)", RGB(204, 204, 204) )
            Licz = Licz + 1
        End If
    
        'pierwszy czwartek miesiąca
        If t = 5 AND  Day(d) >= 1 AND Day(d) <= 7 Then
            Call CellFormat( oSht.getCellByPosition(3, k + Licz), "Pierwszy czwartek miesiąca", RGB(255, 255, 204) )
            Licz = Licz + 1
        End If
    
        'ostatni czwartek miesiąca
        If t = 5 AND Day(d) >= MonthEnd-6 AND Day(d) <= MonthEnd Then
            Call CellFormat( oSht.getCellByPosition(3, k + Licz), "Ostatni czwartek miesiąca", RGB(123, 204, 153) )
            Licz = Licz + 1
        End If
    
    'Końcowe formatowanie wpisu - scalanie komórek
        If Licz > 1 Then
            oSht.getCellRangeByPosition(0, k, 0, k + Licz - 1).merge(True) 'scalamy komórki w kolumnach: A,B,C,E,F,G,H
            oSht.getCellRangeByPosition(1, k, 1, k + Licz - 1).merge(True)
            oSht.getCellRangeByPosition(2, k, 2, k + Licz - 1).merge(True)
            oSht.getCellRangeByPosition(4, k, 4, k + Licz - 1).merge(True)
            oSht.getCellRangeByPosition(5, k, 5, k + Licz - 1).merge(True)
            oSht.getCellRangeByPosition(6, k, 6, k + Licz - 1).merge(True)
            oSht.getCellRangeByPosition(7, k, 7, k + Licz - 1).merge(True)
            k = k + Licz
        Else
            k = k + 1
        End If
        d = d + 1
    Loop
    
    oColumns = oSht.getColumns() 'uchwyt do kolumn pierwszego arkusza
    oColumns.getByIndex(2).Width = 500 'szerokość kolumny C - 5 mm
    oColumns.getByIndex(3).Width = 7000 'szerokość kolumny D - 70 mm
    oColumns.getByIndex(4).Width = 1500 'szerokość kolumny E - 15 mm
    oColumns.getByIndex(5).Width = 7000 'szerokość kolumny F - 70 mm
    oColumns.getByIndex(6).Width = 1500 'szerokość kolumny G - 15 mm
    oColumns.getByIndex(7).Width = 7000 'szerokość kolumny H - 70 mm
    MsgBox "Ukończono!"
End Sub
Sub CellFormat(oCll as Object, CellString as String, CellColor as Long)
    Dim CellRow as Long
    CellRow = oCll.getCellAddress().Row
    oCll.Spreadsheet.getRows().getByIndex(CellRow).Height = 1000 'ustawia wysokość wiersza równą 10 mm
    oCll.String = CellString 'wpisuje tekst
    oCll.CellBackColor = CellColor 'ustawia kolor tła komórki
    oCll.CharHeight = 11 'rozmiar czcionki
    oCll.CharWeight = com.sun.star.awt.FontWeight.NORMAL 'zwykła czcionka
    oCll.setPropertyValue( "IsTextWrapped", True ) 'zawija tekst automatycznie
    oCll.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER 'wyśrodkowanie tekstu w poziomie
    oCll.VertJustify = com.sun.star.table.CellVertJustify.CENTER 'wyśrodkowanie tekstu w pionie
    Call RangeBorder(oCll, RGB(0, 0, 0), 0, 26) 'obramowanie komórki
End Sub
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
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 RangeBorder(oRng as Object, LColor as Long, LStyle as Long, LWidth as Long)
    'LStyle: 0-ciągła, 1-kropkowana, 2-przerywana, 3-podwójna, ... (LINK)
    Dim oBorder as New com.sun.star.table.BorderLine2
    oBorder.Color = LColor
    oBorder.LineStyle = LStyle
    If LStyle = 3 Then 'DOUBLE
    'InnerLineWidth - szerokość linii wewnętrznej w 1/100 mm (gdy równa zero, rysowana jest tylko jedna linia)
    'LineDistance - odległość między linią wewnętrzną i linią zewnętrzną w 1/100 mm
    'OuterLineWidth - szerokość pojedynczej linii lub szerokość linii zewnętrznej w 1/100 mm
    '(gdy równa zero, żadna linia nie jest rysowana)
        oBorder.InnerLineWidth = LWidth
        oBorder.LineDistance = 2 * LWidth
        oBorder.OuterLineWidth = LWidth
    Else
    'LineWidth - szerokość linii w 1/100 mm (gdy równa zero, żadna linia nie jest rysowana)
    'szerokość linii możemy ustawić dla LStyle =  0, 1, 2, 14, 16, 17
        oBorder.LineWidth = LWidth
    End If
    With oRng
        .TopBorder = oBorder
        .RightBorder = oBorder
        .BottomBorder = oBorder
        .LeftBorder = oBorder
    End With
End Sub





LibreOffice Calc – makra                   Strona główna