1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CreateTable" script:language="StarBasic">Option Explicit 4 5Public Const FirstDayRow = 5 ' Row on month sheet for first day of month 6Public Const DateColumn% = 3 ' Column on month sheet with days 7Public Const NewYearRow = 4 ' Row on year sheet for January 1st 8Public Const NewYearColumn = 2 ' Column on year sheet for January 1st 9 10 11Sub CalCreateYearTable(ByVal iSelYear as Integer) 12' Completes the overview for whole year 13 14' Needed by StarOffice Calc and StarOffice Schedule 15Dim CalDay as Integer 16Dim CalMonth as Integer 17Dim i as Integer 18Dim s as Integer 19Dim oYearCell as object 20Dim iDate 21Dim ColPos, RowPos as Integer 22Dim oNameCell, oDateCell as Object 23Dim iCellValue as Long 24Dim oRangeFebCell, oCellAddress, oFebcell as Object 25Dim oRangeBlank as Object 26Dim sBlankStyle as String 27' On Error Goto ErrorHandling 28 oStatusLine.Start("",140) 'GetResText(sProgress) 29 iDate = DateSerial(iSelYear,1,1) 30 oYearCell = oSheet.GetCellRangeByName("Year") 31 oYearCell.Value = iSelYear 32 33 CalMonth = 1 34 CalDay = 0 35 s = 10 36 oStatusLine.SetValue(s) 37 For i = 1 To 374 38 CalDay = CalDay+1 39 If CalDay = 32 Then 40 CalDay = 1 41 CalMonth = CalMonth+1 42 s = s + 10 43 oStatusLine.SetValue(s) 44 End If 45 ColPos = NewYearColumn+(2*CalMonth) 46 RowPos = NewYearRow + CalDay 47 FormatCalCells(ColPos,RowPos,i) 48 Next 49 If NOT CalIsLeapYear(iSelYear) Then 50 ' Delete 29th February if necessary 51 oRangeFebCell = oSheet.GetCellRangeByName("Feb29") 52 oCellAddress = oRangeFebCell.RangeAddress 53 oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) 54 oFebCell.String = "" 55 ' Change the CellStyle according to the Range "Blank" 56 oRangeBlank = oSheet.GetCellRangebyName("Blank") 57 sBlankStyle = oRangeBlank.CellStyle 58 oRangeFebCell.CellStyle = sBlankStyle 59 End If 60 oStatusLine.SetValue(150) 61 ErrorHandling: 62 If Err <> 0 Then 63 MsgBox sError$, 16, sWizardTitle$ 64 End If 65End Sub 66 67 68 69Sub CalCreateMonthTable(ByVal iSelYear as Integer, iSelMonth as Integer) 70Dim oMonthCell, oDateCell as Object 71Dim iDate as Date 72Dim oAddress 73Dim i, s as Integer 74Dim iStartDay as Integer 75 76' Completes the monthly calendar 77'On Error Goto ErrorHandling 78 oStatusLine.Start("",40) 'GetResText(sProgess) 79 ' Set month 80 oMonthCell = oSheet.GetCellRangeByName("Month") 81 82 iDate = DateSerial(iSelYear,iSelMonth,1) 83 oMonthCell.Value = iDate 84 ' Inserting holidays 85 iStartDay = (iSelMonth - 1) * 31 + 1 86 s = 5 87 For i = iStartDay To iStartDay + 30 88 oStatusLine.SetValue(s) 89 s = s + 1 90 FormatCalCells(DateColumn+1,FirstDayRow + i - iStartDay,i) 91 Next 92 oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-iStartDay - 1) 93 oAddress = oDateCell.RangeAddress 94 95 Select Case iSelMonth 96 Case 2,4,6,9,11 97 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 98 If iSelMonth = 2 Then 99 oAddress.StartRow = oAddress.StartRow - 1 100 oAddress.EndRow = oAddress.StartRow 101 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 102 If Not CalIsLeapYear(iSelYear) Then 103 oAddress.StartRow = oAddress.StartRow - 1 104 oAddress.EndRow = oAddress.StartRow 105 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 106 End If 107 End If 108 End Select 109 oStatusLine.SetValue(45) 110ErrorHandling: 111 If Err <> 0 Then 112 MsgBox sError$, 16, sWizardTitle$ 113 End If 114End Sub 115 116 117 118Sub FormatCalCells(ColPos,RowPos,i as Integer) 119Dim oNameCell, oDateCell as Object 120Dim iCellValue as Long 121 oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos) 122 If oDateCell.Value <> 0 Then 123 iCellValue = oDateCell.Value 124 oDateCell.Value = iCellValue 125 If CalBankHolidayName$(i) <> "" Then 126 oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos) 127 oNameCell.String = CalBankHolidayName$(i) 128 If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then 129 oDateCell.CellStyle = cCalStyleWeekend$ 130 End If 131 End If 132 End If 133End Sub</script:module>