gistfile1.txt

REM  *****  BASIC  *****
Option Explicit

Dim gdteBirth As Date
Dim gdteNow As Date 

'Globals for WriteCell - not the neatest, but no mixed array possible
Dim glngRGB As Long
Dim gstrCellContent As String

Const DOB = "$DF$5"
Const COUNT_DATE = "$DF$7"
Const BIRTHDAY = "$DF$9"

Const COL = "$DF$3"
Const ROW = "$DH$3"

'**** SUB Main ****
Sub Main
	
Dim objCalc As Object
Dim objSheet As Object
Dim objCell As Object	
Dim objSheets As Object
	
Dim intColCount As Integer
Dim intRowCount As Integer

Dim intCol As Integer
Dim intRow As Integer

Dim strSheetName As String

Dim intSheet As Integer

Dim dteCount As Date
 
	GlobalScope.BasicLibraries.LoadLibrary("Tools")
	
	strSheetName = "Life Calendar"
		
	objCalc = ThisComponent
	

 	objSheets = objCalc.getSheets()
	
	'Make sure we're working with Life Calendar sheet, leave otherwise
 	intSheet = Misc.GetSheetIndex(objSheets,strSheetName)
	If intSheet < 0 Then
		'To-Do: show a message box
		Exit Sub
	End If

	'If DOB is empty, we can't do anything, so exit
	If ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(DOB).Value = "" Then
		Exit Sub
	End If
	
	'Initialize dates for display
	gdteBirth = ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(DOB).Value
	gdteNow = Now()
	
	objSheet = objCalc.Sheets(intSheet)
	
	Dim dteBirthday
	
	'If we only have DOB set the other fields
	If ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COUNT_DATE).String = "" Then
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COUNT_DATE).Value = DateAdd("d", 7, gdteBirth)
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COL).Value = 2
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(ROW).Value = 2
	End If
	If ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(BIRTHDAY).String = "" Then
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(BIRTHDAY).Value = DateAdd("yyyy",1,gdteBirth)
	End If

	'Initialise intCol and intRow to top left
	intCol = ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COL).Value
	intRow = ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(ROW).Value
	
	'Set the date variables from the fields
	dteBirthday = ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(BIRTHDAY).Value
	dteCount = ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COUNT_DATE).Value
	
	While dteCount <= gdteNow

		'Initialise WriteCell globals
		glngRGB = RGB(0,0,0)
		gstrCellContent = ""
	
		'Colour Cells
		'WriteCell(strSheetName,intCol,intRow, <colour>, <start>, <end>, <cell date>, <heading>)
		WriteCell(strSheetName,intCol,intRow, RGB(0,0,0), gdteBirth, gdteNow, dteCount, "Life lived")
		
		WriteCell(strSheetName,intCol,intRow,RGB(255,255,0), gdteBirth, UKDate("31/8/1982"), dteCount,"Pre School")
		WriteCell(strSheetName,intCol,intRow,RGB(0,204,51), UKDate("1/9/1982"), UKDate("1/6/1996"), dteCount, "School")

    'Add further WriteCell calls for other life events (university, travels, work, etc.)

		'Output the RGB value and cell content now we know what we definitely need to write	
		ThisComponent.Sheets.getByName(strSheetName).getCellByPosition(intCol, intRow).CellBackColor = glngRGB
		ThisComponent.Sheets.getByName(strSheetName).getCellByPosition(intCol, intRow).String = gstrCellContent
	
		'Add one week to the count date
		intCol = intCol + 2
		dteCount = DateAdd("d", 7, dteCount)
		
		'If we've gone past a birthday add a row and reset the column count
		If dteCount >= dteBirthday Then
			intRow = intRow + 2
			dteBirthday = DateAdd("yyyy",1,dteBirthday)
			ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(BIRTHDAY).Value = dteBirthday
			intCol = 2
		End If
		
		'Update the field so we don't need to keep rewriting what we've calculated
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COL).Value = intCol
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(ROW).Value = intRow
		ThisComponent.Sheets.getByName(strSheetName).getCellRangeByName(COUNT_DATE).Value = dteCount
	WEnd
	
End Sub 'Main

Sub WriteCell(strSheetName As String, intCol As Integer, intRow As Integer, lngRGB As Long, _
	dteStart As Date, dteEnd As Date, dteCell As Date, strHeading As String)
	
	'If the Cell date is between the start and end date arguments, set colour to RGB value argument and Cell Content to write
	'later
	If dteCell >= dteStart And dteCell < dteEnd Then
		glngRGB = lngRGB
		gstrCellContent = FormatDate(dteCell) & " - " & strHeading
	End If
		
End Sub 'WriteCell

Function UKDate(strDate As String)
Dim arrDate(3) As Integer

	arrDate = Split(strDate,"/")
	UKDate = DateSerial(arrDate(2), arrDate(1), arrDate(0))
End Function 'UKDate

Function FormatDate(dte As Date)
Dim strDay As String
Dim strMonth As String
Dim strYear As String
Dim strOutput As String

	strDay = Day(dte)
	strMonth = Month(dte)
	strYear = Year(dte)
	strOutput = strDay & "/" & strMonth & "/" & strYear
	FormatDate = strOutput
End Function 'FormatDate

'*******************************************************************************'
'Run this Sub to format a blank sheet for the calendar
Sub DrawNinetyYearCalendar()

Const WEEKS = 53
Const LIFESPAN = 90
Const COLUMN_OFFSET = 1
Const ROW_OFFSET = 1

Const BOX_SIZE = 490
Const SPACER_SIZE = 260

Dim objSheet As Object

Dim intColCount As Integer
Dim intRowCount As Integer

	objSheet = ThisComponent.GetCurrentController.ActiveSheet
	
	'Set the column widths for 53 weeks * 2
	For intColCount = COLUMN_OFFSET To WEEKS * 2 + (COLUMN_OFFSET - 1)	
		Select Case (intColCount Mod 2)
			Case 0
				objSheet.Columns(intColCount).Width = BOX_SIZE
			Case 1
				objSheet.Columns(intColCount).Width = SPACER_SIZE
		End Select		
	Next
	objSheet.Columns(intColCount).Width = BOX_SIZE
	
	'Set the row height for 90 years 0 - 89
	For intRowCount = ROW_OFFSET To LIFESPAN * 2 + (ROW_OFFSET - 1)
		Select Case (intRowCount Mod 2)
			Case 0
				objSheet.Rows(intRowCount).Height = BOX_SIZE
			Case 1
				objSheet.Rows(intRowCount).Height = SPACER_SIZE
		End Select		
		
	Next 
	
	'Populate column headings
	For intColCount = 1 To WEEKS
		objSheet.getCellByPosition(intColCount * 2 + (COLUMN_OFFSET - 1),0).Value = intColCount
	Next
	
	'Populate row headings
	For intRowCount = 0 To LIFESPAN - 1
		objSheet.getCellByPosition(0, intRowCount * 2 + (ROW_OFFSET + 1)).Value = intRowCount
	Next
	
	'Write the variable headings
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), (ROW_OFFSET + 1)).String = "Col:"
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), (ROW_OFFSET + 1)).CharWeight = com.sun.star.awt.FontWeight.BOLD
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), 2 + (ROW_OFFSET + 1)).String = "DOB:"
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), 2 + (ROW_OFFSET + 1)).CharWeight = com.sun.star.awt.FontWeight.BOLD
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), 4 + (ROW_OFFSET + 1)).String = "Date:"
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), 4 + (ROW_OFFSET + 1)).CharWeight = com.sun.star.awt.FontWeight.BOLD
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), 6 + (ROW_OFFSET + 1)).String = "Birthday:"
	objSheet.getCellByPosition(WEEKS * 2 + 2 + (COLUMN_OFFSET - 1), 6 + (ROW_OFFSET + 1)).CharWeight = com.sun.star.awt.FontWeight.BOLD
		
	objSheet.getCellByPosition(WEEKS * 2 + 4 + (COLUMN_OFFSET - 1), (ROW_OFFSET + 1)).String = "Row:"
	objSheet.getCellByPosition(WEEKS * 2 + 4 + (COLUMN_OFFSET - 1), (ROW_OFFSET + 1)).CharWeight = com.sun.star.awt.FontWeight.BOLD
	
	'Draw borders around cells
	For intRowCount = 0 To LIFESPAN - 1
		For intColCount = 1 To WEEKS
			DrawBorder(intColCount * 2 + (COLUMN_OFFSET - 1),intRowCount * 2 + (ROW_OFFSET + 1))
		Next
	Next
	
End Sub 'DrawNinetyYearCalendar

Sub DrawBorder(intCol As Integer, intRow As Integer)
Dim objBasicBorder as New com.sun.star.table.BorderLine
Dim objCell As Object

	objBasicBorder.Color = RGB(0, 0, 0)
	objBasicBorder.InnerLineWidth = 0
	objBasicBorder.OuterLineWidth = 2
	objBasicBorder.LineDistance = 0
	
	objCell = ThisComponent.GetCurrentController.ActiveSheet.getCellByPosition(intCol,intRow).TableBorder
	objCell.LeftLine = objBasicBorder
	objCell.TopLine = objBasicBorder
	objCell.RightLine = objBasicBorder
	objCell.BottomLine = objBasicBorder   
	ThisComponent.GetCurrentController.ActiveSheet.getCellByPosition(intCol,intRow).TableBorder = objCell

End Sub 'DrawBorder

This txt file can be added as an OpenOffice macro to draw a 90 Year Calendar. Use the DrawNinetyYearCalendar procedure to draw the initial form on a blank sheet. The Main procedure will then fill in the calendar based on the life events you add. Make sure to set the DOB field.