Eksempel:
REM ***** BASIC *****
Sub Main
this_year = InputBox ("Indtast årstal mellem 1583 og 3000", "Vælg årstal", year(date))
'Kontroller at årstallet brugbart
If (1583 > val(this_year) OR val(this_year) > 3000) then
MsgBox("Årstallet skal være mellem 1583 og 3000", 48, "Fejl")
Stop
End If
Cal_name="Kalender " & this_year
'Kontroller at dokumentet er et regneark
my_doc = ThisComponent
If not my_doc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") then
MsgBox("Dokumentet skal være et regneark", 48, "Fejl")
Stop
End if
my_sheets = my_doc.Sheets
antal=my_sheets.count
If NOT my_sheets.hasbyName(Cal_name) Then
my_sheets.insertNewByName(Cal_name, antal)
End If
the_sheet = my_sheets.getByName(Cal_name)
'Formatér siden
oStyles = my_doc.StyleFamilies.getByName("PageStyles")
oPstyle = oStyles.getByName(the_sheet.PageStyle)
oPstyle.FooterIsOn = False
oPstyle.FooterIsOn = False
oPstyle.TopMargin=500
'Første linje
oRange = the_sheet.getCellRangeByName("A1:L1")
oRange.merge(True)
oCell= the_sheet.getCellByPosition(0, 0)
oCell.String = Cal_name
FormatDark(oCell)
oRange = the_sheet.getCellRangeByName("M1:X1")
oRange.merge(True)
oCell= the_sheet.getCellByPosition(12, 0)
oCell.String = Cal_name
FormatDark(oCell)
'Nederste linje
oRange = the_sheet.getCellRangeByName("A34:X34")
oRange.merge(True)
oCell = the_sheet.getCellRangeByName("A34")
FormatDark(oCell)
For m = 1 to 12
'Overskriften
oRange = the_sheet.getCellRangeByPosition(m*2-1-1,1,m*2-1,1)
oRange.merge(True)
the_cell = the_sheet.getCellByPosition(m*2-1-1, 1)
the_cell.String=TheMonthName(m)
the_cell.HoriJustify = 2
the_cell.CellBackColor=rgb(150,150,150)
the_cell.CharColor=rgb(255,255,255)
'Justerer kolonnebredder
Column= the_sheet.Columns(m*2-1-1)
Column.Width=550
Column= the_sheet.Columns(m*2-1)
Column.Width=4000
Next m
'For hver måned...
For m = 1 to 12
'Dag for dag...
For d= 1 to Day(LastDayOfMonth(DateValue("1-" & m & "-" & this_year))
the_date=DateValue(d & "-" & m & "-" & this_year)
'Skriv datoen i første kolonne
the_cell = the_sheet.getCellByPosition(m*2-1-1, d + 1)
the_cell.Value=the_date
the_cell.NumberFormat=109
'Formatter cellen
FormatLight(the_cell)
'Skriv ugedagens bogstav i anden kolonne
the_Othercell = the_sheet.getCellByPosition(m*2-1, d + 1)
'Lørdag og søndag formateres
Select Case WeekDay(the_date)
Case 1
FormatLight(the_Othercell)
the_Othercell.String="S"
Case 2
the_Othercell.String="M"
Case 3
the_Othercell.String="T"
Case 4
the_Othercell.String="O"
Case 5
the_Othercell.String="T"
Case 6
the_Othercell.String="F"
Case 7
FormatLight(the_Othercell)
the_Othercell.String="L"
End Select
'Tilføj helligdage
generic_date= left(STR(the_date),5)
oFA = createUnoService( "com.sun.star.sheet.FunctionAccess" )
'Faste helligdage
Select Case generic_date
case "01-01"
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String & " Nytårsdag"
case "05-06"
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Grundlovsdag"
case "24-12"
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Juleaften"
case "25-12"
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Juledag"
case "26-12"
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" 2. Juledag"
'Skæve helligdage
'Der findes ingen påske-beregning i Basic, men vi kan eksekvere regnearksfunktionen =Påskedag)
the_Othercell.String=the_Othercell.String &" Påskedag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )+1 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" 2. Påskedag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )-2 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Langfredag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )-3 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Skærtorsdag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )+49 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Pinsedag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )+50 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" 2. Pinsedag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )+26 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" St. Bededag"
case Left(STR(CDate(oFA.callFunction( "EASTERSUNDAY", array( this_year ) )+39 ) ),5)
FormatLight(the_Othercell)
the_Othercell.String=the_Othercell.String &" Kr. Himmelfartsdag"
End Select
Next d 'Dags-loopet slutter
Next m 'Måneds-loopet slutter
End Sub
Function LastDayOfMonth(d As Date) As Date
'Beregn hvor mange dage i måneden
Dim nYear As Integer
Dim nMonth As Integer
nYear = Year(d) 'Current year
nMonth = Month(d) + 1 'Next month, unless it was December.
If nMonth > 12 Then 'If it is December then nMonth is now 13
nMonth = 1 'Roll the month back to 1
nYear = nYear + 1 'but increment the year
End If
LastDayOfMonth = CDate(DateSerial(nYear, nMonth, 1)-1)
End Function
Function TheMonthName(m)
'Omsætter månedstal til månedsnavn
CompatibilityMode(True)
TheMonthName=MonthName(m)
End Function
Sub FormatLight(oCell)
'Formatér lys grå
oCell.CellBackColor=rgb(200,200,200)
oCell.CharColor=rgb(255,255,255)
End Sub
Sub FormatDark(oCell)
'Formatér overskrift
oCell.CharHeight=18
oCell.HoriJustify = 2
oCell.CellBackColor=rgb(100,100,100)
oCell.CharColor=rgb(255,255,255)
End Sub