diff options
Diffstat (limited to 'wizards/source/schedule/CreateTable.xba')
| -rw-r--r-- | wizards/source/schedule/CreateTable.xba | 133 |
1 files changed, 0 insertions, 133 deletions
diff --git a/wizards/source/schedule/CreateTable.xba b/wizards/source/schedule/CreateTable.xba deleted file mode 100644 index 6d472a84b..000000000 --- a/wizards/source/schedule/CreateTable.xba +++ /dev/null @@ -1,133 +0,0 @@ -<?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 |