Terminarz
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