home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #3 / K-CD_2002-03.iso / OpenOffice / f_0031 / CreateTable.xba < prev    next >
Extensible Markup Language  |  2001-08-24  |  4KB  |  136 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 iSelYear as Integer)
  12. ' Completes the overview for whole year
  13.  
  14. ' 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. '    On Error Goto ErrorHandling
  28.     oStatusLine.Start("",140)    'GetResText(sProgress)
  29.  
  30.     iDate = DateSerial(iSelYear,1,1)
  31.  
  32.     ' Insert year
  33.     oYearCell = oSheet.GetCellRangeByName("Year")
  34.     oYearCell.Value = iSelYear
  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(iSelYear) 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 iSelYear as Integer, iSelMonth as Integer)
  73. Dim oMonthCell, oDateCell as Object
  74. Dim iDate as Date
  75. Dim oAddress
  76. Dim i, s as Integer
  77. Dim iStartDay as Integer
  78.  
  79. ' Completes the monthly calendar
  80. 'On Error Goto ErrorHandling
  81.     oStatusLine.Start("",40)        'GetResText(sProgess)
  82.     ' Set month
  83.     oMonthCell = oSheet.GetCellRangeByName("Month")
  84.     
  85.     iDate = DateSerial(iSelYear,iSelMonth,1)
  86.     oMonthCell.Value = iDate
  87.     ' Inserting holidays
  88.     iStartDay = (iSelMonth - 1) * 31 + 1
  89.     s = 5
  90.     For i = iStartDay To iStartDay + 30
  91.         oStatusLine.SetValue(s)
  92.         s = s + 1
  93.         FormatCalCells(DateColumn+1,FirstDayRow + i - iStartDay,i)
  94.     Next
  95.     oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-iStartDay - 1)
  96.     oAddress = oDateCell.RangeAddress
  97.     
  98.     Select Case iSelMonth
  99.         Case 2,4,6,9,11
  100.             oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) 
  101.             If TargetMonth = 2 Then
  102.                 oAddress.StartRow = oAddress.StartRow - 1    
  103.                 oAddress.EndRow = oAddress.StartRow
  104.                 oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
  105.                 If Not CalIsLeapYear(iSelYear) Then
  106.                     oAddress.StartRow = oAddress.StartRow - 1    
  107.                     oAddress.EndRow = oAddress.StartRow
  108.                     oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
  109.                 End If
  110.             End If
  111.     End Select
  112.     oStatusLine.SetValue(45)
  113. ErrorHandling:
  114.     If Err <> 0 Then
  115.         MsgBox sError$, 16, sWizardTitle$
  116.     End If
  117. End Sub
  118.  
  119.  
  120.  
  121. Sub FormatCalCells(ColPos,RowPos,i as Integer)
  122. Dim oNameCell, oDateCell as Object
  123. Dim iCellValue as Long
  124.     oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos)
  125.     If oDateCell.Value <> 0 Then
  126.         iCellValue = oDateCell.Value
  127.         oDateCell.Value = iCellValue
  128.         If CalBankHolidayName$(i) <> "" Then
  129.             oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos)
  130.             oNameCell.String = CalBankHolidayName$(i)
  131.             If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then
  132.                 oDateCell.CellStyle = cCalStyleWeekend$
  133.             End If
  134.         End If
  135.     End If
  136. End Sub</script:module>