1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
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>
|
