home *** CD-ROM | disk | FTP | other *** search
/ com!online 2001 December / COMCD1201.iso / openoffice / f_0031 / CreateTable.xba < prev    next >
Encoding:
Extensible Markup Language  |  2001-07-20  |  4.4 KB  |  137 lines
  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          ' Row on month sheet for first day of month
  6. Public Const DateColumn% = 3          ' Column on month sheet with days
  7. Public Const NewYearRow = 4           ' Row on year sheet for January 1st
  8. Public Const NewYearColumn = 2        ' Column on year sheet for January 1st
  9.  
  10.  
  11. Sub CalCreateYearTable(ByVal YearInt%)
  12. ' Completes the overview for whole year
  13.  
  14. ' Needed by StarOffice Calc and StarOffice Schedule
  15. Dim CalDay%, CalMonth%, Count%, nCount%
  16.  
  17. ' Only needed by StarOffice Schedule
  18. Dim oYearCell as object
  19. Dim iDate
  20. Dim i, s as Integer
  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.     On Error Goto ErrorHandling
  28.     oStatusLine.Start(GetResText(sProgress),140)
  29.  
  30.     iDate = DateSerial(Val(DlgCalModel.txtYear.Text),1,1)
  31.  
  32.     ' Insert year
  33.     oYearCell = oSheet.GetCellRangeByName("Year")
  34.     oYearCell.Value = Val(DlgCalModel.txtYear.Text)
  35.     ' Insert holidays
  36.     CalMonth% = 1
  37.     CalDay% = 0
  38.     s = 10
  39.     oStatusLine.SetValue(s)
  40.     For i = 1 To 374
  41.         CalDay = CalDay+1
  42.         If CalDay = 32 Then
  43.             CalDay = 1
  44.             CalMonth = CalMonth+1
  45.             s = s + 10
  46.             oStatusLine.SetValue(s)
  47.         End If
  48.         ColPos = NewYearColumn+(2*CalMonth)
  49.         RowPos = NewYearRow + CalDay
  50.         FormatCalCells(ColPos,RowPos,i)            
  51.     Next
  52.     If NOT CalIsLeapYear(Val(txtYear.Text)) Then
  53.         ' Delete 29th February if necessary
  54.         oRangeFebCell = oSheet.GetCellRangeByName("Feb29")
  55.         oCellAddress = oRangeFebCell.RangeAddress
  56.         oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow)
  57.         oFebCell.String = ""
  58.         ' Change the CellStyle according to the Range "Blank"
  59.         oRangeBlank = oSheet.GetCellRangebyName("Blank")
  60.         sBlankStyle = oRangeBlank.CellStyle
  61.         oRangeFebCell.CellStyle = sBlankStyle
  62.     End If
  63.     oStatusLine.SetValue(150)
  64.     ErrorHandling:
  65.     If Err <> 0 Then
  66.         MsgBox sError$, 16, sWizardTitle$
  67.     End If
  68. End Sub
  69.  
  70.  
  71.  
  72. Sub CalCreateMonthTable(ByVal YearInt%, ByVal MonthInt%)
  73. Dim oMonthCell, oDateCell as Object
  74. Dim iDate as Date
  75. Dim oAddress
  76. Dim i, s as Integer
  77. Dim StartDay%, TargetMonth%
  78.  
  79. ' Completes the monthly calendar
  80. On Error Goto ErrorHandling
  81.     oStatusLine.Start(GetResText(sProgess),40)
  82.     ' Set month
  83.     TargetMonth% = CalGetIntOfShortMonthName%(txtMonth.Text)
  84.     oMonthCell = oSheet.GetCellRangeByName("Month")
  85.  
  86.     iDate = DateSerial(Val(DlgCalModel.txtYear.Text),TargetMonth%,1)
  87.     oMonthCell.Value = iDate
  88.     ' Inserting holidays
  89.     StartDay% = (TargetMonth% - 1) * 31 + 1
  90.     s = 5
  91.     For i = StartDay% To StartDay%+30
  92.         oStatusLine.SetValue(s)
  93.         s = s + 1
  94.         FormatCalCells(DateColumn+1,FirstDayRow+i-StartDay,i)
  95.     Next
  96.     oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-StartDay - 1)
  97.     oAddress = oDateCell.RangeAddress
  98.     
  99.     Select Case TargetMonth
  100.         Case 2,4,6,9,11
  101.             oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 
  102.             If TargetMonth = 2 Then
  103.                 oAddress.StartRow = oAddress.StartRow - 1    
  104.                 oAddress.EndRow = oAddress.StartRow
  105.                 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
  106.                 If Not CalIsLeapYear(Val(txtYear.Text)) Then
  107.                     oAddress.StartRow = oAddress.StartRow - 1    
  108.                     oAddress.EndRow = oAddress.StartRow
  109.                     oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
  110.                 End If
  111.             End If
  112.     End Select
  113.     oStatusLine.SetValue(45)
  114. ErrorHandling:
  115.     If Err <> 0 Then
  116.         MsgBox sError$, 16, sWizardTitle$
  117.     End If
  118. End Sub
  119.  
  120.  
  121.  
  122. Sub FormatCalCells(ColPos,RowPos,i as Integer)
  123. Dim oNameCell, oDateCell as Object
  124. Dim iCellValue as Long
  125.     oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos)
  126.     If oDateCell.Value <> 0 Then
  127.         iCellValue = oDateCell.Value
  128.         oDateCell.Value = iCellValue
  129.         If CalBankHolidayName$(i) <> "" Then
  130.             oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos)
  131.             oNameCell.String = CalBankHolidayName$(i)
  132.             If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then
  133.                 oDateCell.CellStyle = cCalStyleWeekend$
  134.             End If
  135.         End If
  136.     End If
  137. End Sub</script:module>