diff options
Diffstat (limited to 'wizards/source/schedule/CreateTable.xba')
| -rw-r--r-- | wizards/source/schedule/CreateTable.xba | 133 |
1 files changed, 133 insertions, 0 deletions
diff --git a/wizards/source/schedule/CreateTable.xba b/wizards/source/schedule/CreateTable.xba new file mode 100644 index 000000000000..6d472a84bca4 --- /dev/null +++ b/wizards/source/schedule/CreateTable.xba @@ -0,0 +1,133 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CreateTable" script:language="StarBasic">Option Explicit + +Public Const FirstDayRow = 5 ' Row on month sheet for first day of month +Public Const DateColumn% = 3 ' Column on month sheet with days +Public Const NewYearRow = 4 ' Row on year sheet for January 1st +Public Const NewYearColumn = 2 ' Column on year sheet for January 1st + + +Sub CalCreateYearTable(ByVal iSelYear as Integer) +' Completes the overview for whole year + +' Needed by StarOffice Calc and StarOffice Schedule +Dim CalDay as Integer +Dim CalMonth as Integer +Dim i as Integer +Dim s as Integer +Dim oYearCell as object +Dim iDate +Dim ColPos, RowPos as Integer +Dim oNameCell, oDateCell as Object +Dim iCellValue as Long +Dim oRangeFebCell, oCellAddress, oFebcell as Object +Dim oRangeBlank as Object +Dim sBlankStyle as String +' On Error Goto ErrorHandling + oStatusLine.Start("",140) 'GetResText(sProgress) + iDate = DateSerial(iSelYear,1,1) + oYearCell = oSheet.GetCellRangeByName("Year") + oYearCell.Value = iSelYear + + CalMonth = 1 + CalDay = 0 + s = 10 + oStatusLine.SetValue(s) + For i = 1 To 374 + CalDay = CalDay+1 + If CalDay = 32 Then + CalDay = 1 + CalMonth = CalMonth+1 + s = s + 10 + oStatusLine.SetValue(s) + End If + ColPos = NewYearColumn+(2*CalMonth) + RowPos = NewYearRow + CalDay + FormatCalCells(ColPos,RowPos,i) + Next + If NOT CalIsLeapYear(iSelYear) Then + ' Delete 29th February if necessary + oRangeFebCell = oSheet.GetCellRangeByName("Feb29") + oCellAddress = oRangeFebCell.RangeAddress + oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) + oFebCell.String = "" + ' Change the CellStyle according to the Range "Blank" + oRangeBlank = oSheet.GetCellRangebyName("Blank") + sBlankStyle = oRangeBlank.CellStyle + oRangeFebCell.CellStyle = sBlankStyle + End If + oStatusLine.SetValue(150) + ErrorHandling: + If Err <> 0 Then + MsgBox sError$, 16, sWizardTitle$ + End If +End Sub + + + +Sub CalCreateMonthTable(ByVal iSelYear as Integer, iSelMonth as Integer) +Dim oMonthCell, oDateCell as Object +Dim iDate as Date +Dim oAddress +Dim i, s as Integer +Dim iStartDay as Integer + +' Completes the monthly calendar +'On Error Goto ErrorHandling + oStatusLine.Start("",40) 'GetResText(sProgess) + ' Set month + oMonthCell = oSheet.GetCellRangeByName("Month") + + iDate = DateSerial(iSelYear,iSelMonth,1) + oMonthCell.Value = iDate + ' Inserting holidays + iStartDay = (iSelMonth - 1) * 31 + 1 + s = 5 + For i = iStartDay To iStartDay + 30 + oStatusLine.SetValue(s) + s = s + 1 + FormatCalCells(DateColumn+1,FirstDayRow + i - iStartDay,i) + Next + oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-iStartDay - 1) + oAddress = oDateCell.RangeAddress + + Select Case iSelMonth + Case 2,4,6,9,11 + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + If iSelMonth = 2 Then + oAddress.StartRow = oAddress.StartRow - 1 + oAddress.EndRow = oAddress.StartRow + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + If Not CalIsLeapYear(iSelYear) Then + oAddress.StartRow = oAddress.StartRow - 1 + oAddress.EndRow = oAddress.StartRow + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + End If + End If + End Select + oStatusLine.SetValue(45) +ErrorHandling: + If Err <> 0 Then + MsgBox sError$, 16, sWizardTitle$ + End If +End Sub + + + +Sub FormatCalCells(ColPos,RowPos,i as Integer) +Dim oNameCell, oDateCell as Object +Dim iCellValue as Long + oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos) + If oDateCell.Value <> 0 Then + iCellValue = oDateCell.Value + oDateCell.Value = iCellValue + If CalBankHolidayName$(i) <> "" Then + oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos) + oNameCell.String = CalBankHolidayName$(i) + If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then + oDateCell.CellStyle = cCalStyleWeekend$ + End If + End If + End If +End Sub</script:module>
\ No newline at end of file |