1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<!--*********************************************************** 4 * 5 * Licensed to the Apache Software Foundation (ASF) under one 6 * or more contributor license agreements. See the NOTICE file 7 * distributed with this work for additional information 8 * regarding copyright ownership. The ASF licenses this file 9 * to you under the Apache License, Version 2.0 (the 10 * "License"); you may not use this file except in compliance 11 * with the License. You may obtain a copy of the License at 12 * 13 * http://www.apache.org/licenses/LICENSE-2.0 14 * 15 * Unless required by applicable law or agreed to in writing, 16 * software distributed under the License is distributed on an 17 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 18 * KIND, either express or implied. See the License for the 19 * specific language governing permissions and limitations 20 * under the License. 21 * 22 ***********************************************************--> 23<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CreateTable" script:language="StarBasic">Option Explicit 24 25Public Const FirstDayRow = 5 ' Row on month sheet for first day of month 26Public Const DateColumn% = 3 ' Column on month sheet with days 27Public Const NewYearRow = 4 ' Row on year sheet for January 1st 28Public Const NewYearColumn = 2 ' Column on year sheet for January 1st 29 30 31Sub CalCreateYearTable(ByVal iSelYear as Integer) 32' Completes the overview for whole year 33 34' Needed by StarOffice Calc and StarOffice Schedule 35Dim CalDay as Integer 36Dim CalMonth as Integer 37Dim i as Integer 38Dim s as Integer 39Dim oYearCell as object 40Dim iDate 41Dim ColPos, RowPos as Integer 42Dim oNameCell, oDateCell as Object 43Dim iCellValue as Long 44Dim oRangeFebCell, oCellAddress, oFebcell as Object 45Dim oRangeBlank as Object 46Dim sBlankStyle as String 47' On Error Goto ErrorHandling 48 oStatusLine.Start("",140) 'GetResText(sProgress) 49 iDate = DateSerial(iSelYear,1,1) 50 oYearCell = oSheet.GetCellRangeByName("Year") 51 oYearCell.Value = iSelYear 52 53 CalMonth = 1 54 CalDay = 0 55 s = 10 56 oStatusLine.SetValue(s) 57 For i = 1 To 374 58 CalDay = CalDay+1 59 If CalDay = 32 Then 60 CalDay = 1 61 CalMonth = CalMonth+1 62 s = s + 10 63 oStatusLine.SetValue(s) 64 End If 65 ColPos = NewYearColumn+(2*CalMonth) 66 RowPos = NewYearRow + CalDay 67 FormatCalCells(ColPos,RowPos,i) 68 Next 69 If NOT CalIsLeapYear(iSelYear) Then 70 ' Delete 29th February if necessary 71 oRangeFebCell = oSheet.GetCellRangeByName("Feb29") 72 oCellAddress = oRangeFebCell.RangeAddress 73 oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) 74 oFebCell.String = "" 75 ' Change the CellStyle according to the Range "Blank" 76 oRangeBlank = oSheet.GetCellRangebyName("Blank") 77 sBlankStyle = oRangeBlank.CellStyle 78 oRangeFebCell.CellStyle = sBlankStyle 79 End If 80 oStatusLine.SetValue(150) 81 ErrorHandling: 82 If Err <> 0 Then 83 MsgBox sError$, 16, sWizardTitle$ 84 End If 85End Sub 86 87 88 89Sub CalCreateMonthTable(ByVal iSelYear as Integer, iSelMonth as Integer) 90Dim oMonthCell, oDateCell as Object 91Dim iDate as Date 92Dim oAddress 93Dim i, s as Integer 94Dim iStartDay as Integer 95 96' Completes the monthly calendar 97'On Error Goto ErrorHandling 98 oStatusLine.Start("",40) 'GetResText(sProgess) 99 ' Set month 100 oMonthCell = oSheet.GetCellRangeByName("Month") 101 102 iDate = DateSerial(iSelYear,iSelMonth,1) 103 oMonthCell.Value = iDate 104 ' Inserting holidays 105 iStartDay = (iSelMonth - 1) * 31 + 1 106 s = 5 107 For i = iStartDay To iStartDay + 30 108 oStatusLine.SetValue(s) 109 s = s + 1 110 FormatCalCells(DateColumn+1,FirstDayRow + i - iStartDay,i) 111 Next 112 oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-iStartDay - 1) 113 oAddress = oDateCell.RangeAddress 114 115 Select Case iSelMonth 116 Case 2,4,6,9,11 117 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 118 If iSelMonth = 2 Then 119 oAddress.StartRow = oAddress.StartRow - 1 120 oAddress.EndRow = oAddress.StartRow 121 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 122 If Not CalIsLeapYear(iSelYear) Then 123 oAddress.StartRow = oAddress.StartRow - 1 124 oAddress.EndRow = oAddress.StartRow 125 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 126 End If 127 End If 128 End Select 129 oStatusLine.SetValue(45) 130ErrorHandling: 131 If Err <> 0 Then 132 MsgBox sError$, 16, sWizardTitle$ 133 End If 134End Sub 135 136 137 138Sub FormatCalCells(ColPos,RowPos,i as Integer) 139Dim oNameCell, oDateCell as Object 140Dim iCellValue as Long 141 oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos) 142 If oDateCell.Value <> 0 Then 143 iCellValue = oDateCell.Value 144 oDateCell.Value = iCellValue 145 If CalBankHolidayName$(i) <> "" Then 146 oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos) 147 oNameCell.String = CalBankHolidayName$(i) 148 If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then 149 oDateCell.CellStyle = cCalStyleWeekend$ 150 End If 151 End If 152 End If 153End Sub</script:module> 154