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