wizards/source/schedule/CreateTable.xba

   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
   5 Public Const FirstDayRow = 5          &apos; Row on month sheet for first day of month
   6 Public Const DateColumn% = 3          &apos; Column on month sheet with days
   7 Public Const NewYearRow = 4           &apos; Row on year sheet for January 1st
   8 Public Const NewYearColumn = 2        &apos; Column on year sheet for January 1st
   9
  10
  11 Sub CalCreateYearTable(ByVal iSelYear as Integer)
  12 &apos; Completes the overview for whole year
  13
  14 &apos; Needed by StarOffice Calc and StarOffice Schedule
  15 Dim CalDay as Integer
  16 Dim CalMonth as Integer
  17 Dim i as Integer
  18 Dim s as Integer
  19 Dim oYearCell as object
  20 Dim iDate
  21 Dim ColPos, RowPos as Integer
  22 Dim oNameCell, oDateCell as Object
  23 Dim iCellValue as Long
  24 Dim oRangeFebCell, oCellAddress, oFebcell as Object
  25 Dim oRangeBlank as Object
  26 Dim sBlankStyle as String
  27 &apos;  On Error Goto ErrorHandling
  28         oStatusLine.Start(&quot;&quot;,140)     &apos;GetResText(sProgress)
  29         iDate = DateSerial(iSelYear,1,1)
  30         oYearCell = oSheet.GetCellRangeByName(&quot;Year&quot;)
  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                 &apos; Delete 29th February if necessary
  51                 oRangeFebCell = oSheet.GetCellRangeByName(&quot;Feb29&quot;)
  52                 oCellAddress = oRangeFebCell.RangeAddress
  53                 oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow)
  54                 oFebCell.String = &quot;&quot;
  55                 &apos; Change the CellStyle according to the Range &quot;Blank&quot;
  56                 oRangeBlank = oSheet.GetCellRangebyName(&quot;Blank&quot;)
  57                 sBlankStyle = oRangeBlank.CellStyle
  58                 oRangeFebCell.CellStyle = sBlankStyle
  59         End If
  60         oStatusLine.SetValue(150)
  61         ErrorHandling:
  62         If Err &lt;&gt; 0 Then
  63                 MsgBox sError$, 16, sWizardTitle$
  64         End If
  65 End Sub
  66
  67
  68
  69 Sub CalCreateMonthTable(ByVal iSelYear as Integer, iSelMonth as Integer)
  70 Dim oMonthCell, oDateCell as Object
  71 Dim iDate as Date
  72 Dim oAddress
  73 Dim i, s as Integer
  74 Dim iStartDay as Integer
  75
  76 &apos; Completes the monthly calendar
  77 &apos;On Error Goto ErrorHandling
  78         oStatusLine.Start(&quot;&quot;,40)              &apos;GetResText(sProgess)
  79         &apos; Set month
  80         oMonthCell = oSheet.GetCellRangeByName(&quot;Month&quot;)
  81
  82         iDate = DateSerial(iSelYear,iSelMonth,1)
  83         oMonthCell.Value = iDate
  84         &apos; 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)
 110 ErrorHandling:
 111         If Err &lt;&gt; 0 Then
 112                 MsgBox sError$, 16, sWizardTitle$
 113         End If
 114 End Sub
 115
 116
 117
 118 Sub FormatCalCells(ColPos,RowPos,i as Integer)
 119 Dim oNameCell, oDateCell as Object
 120 Dim iCellValue as Long
 121         oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos)
 122         If oDateCell.Value &lt;&gt; 0 Then
 123                 iCellValue = oDateCell.Value
 124                 oDateCell.Value = iCellValue
 125                 If CalBankHolidayName$(i) &lt;&gt; &quot;&quot; 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
 133 End Sub</script:module>