Monthly Calendar Report -- Can it be done?

  • Thread starter Thread starter Karen
  • Start date Start date
K

Karen

I need to create a printable report which will represent
my data in a Monthly Calendar layout. Is there any way in
Access to accomplish this task? Or is there another
program that can import this data and arrange it in a
monthly calendar layout?
 
Karen,
If you need a simple calendar, put 42 labels in the detail section of the
report. The labels should be named "Label1" through "Label42" and layed out
in 6 rows of 7, just as a printed calendar would be. Label1 is the top left
label and Label42 is the bottom right label. Insert the following code into
the OnOpen event of the report.

Private Sub Report_Open(Cancel As Integer)
Dim curMonth As Byte
Dim curYear As Integer
Dim startDate As Date
Dim monthDays As Byte
Dim lblName As String
Dim lblDay As Byte

curMonth = 8
curYear = 2003

If Not IsDate(curMonth & "/29/" & curYear) Then
monthDays = 28
ElseIf Not IsDate(curMonth & "/30/" & curYear) Then
monthDays = 29
ElseIf Not IsDate(curMonth & "/31/" & curYear) Then
monthDays = 30
Else
monthDays = 31
End If

startDate = CDate(curMonth & "/1/" & curYear)


lblYear.Caption = Year(startDate)
lblMonth.Caption = MonthName(Month(startDate))

Select Case Weekday(startDate, vbSunday)
Case 1 'starts on Sunday
For lblDay = 1 To monthDays
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay
Next
For lblDay = monthDays + 1 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
Case 2 'starts on Monday
Label1.Caption = ""
For lblDay = 2 To monthDays + 1
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay - 1
Next
For lblDay = monthDays + 2 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
Case 3 'starts on Tuesday
Label1.Caption = ""
Label2.Caption = ""
For lblDay = 3 To monthDays + 2
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay - 2
Next
For lblDay = monthDays + 3 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
Case 4 'starts on Wednesday
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
For lblDay = 4 To monthDays + 3
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay - 3
Next
For lblDay = monthDays + 4 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
Case 5 'starts on Thursday
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
For lblDay = 5 To monthDays + 4
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay - 4
Next
For lblDay = monthDays + 5 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
Case 6 'starts on Friday
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label5.Caption = ""
For lblDay = 6 To monthDays + 5
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay - 5
Next
For lblDay = monthDays + 6 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
Case 7 'starts on Saturday
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label5.Caption = ""
Label6.Caption = ""
For lblDay = 7 To monthDays + 6
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = lblDay - 6
Next
For lblDay = monthDays + 7 To 42
lblName = "Label" & lblDay
Me.Controls(lblName).Caption = ""
Next
End Select
End Sub

You can add a function to the report to pull data from a table and append it
to each caption if necessary. If you need more help, send an e-mail and I
will provide a working example.

Paul Webster
 
To display your data in a calendar report, try the samples at
http://www.invisibleinc.com/divFiles.cfm?divDivID=4.

The following will draw a calendar on a blank report (make sure you have a
large detail section).

Private Sub Report_Page()
Dim lngDayHeight As Long
Dim lngDayWidth As Long
Dim datRptDate As Date
Dim intStartWeek As Integer
Dim lngTopMargin As Long
Dim dat1stMth As Date
Dim datDay As Date
Dim lngTop As Long
Dim lngLeft As Long
datRptDate = Date
dat1stMth = DateSerial(Year(datRptDate), Month(datRptDate), 1)
intStartWeek = DatePart("ww", dat1stMth)
lngDayHeight = 2160 'one & half inch
lngDayWidth = 1440 'one inch
lngTopMargin = 720 'half inch
Me.FontSize = 22
'loop through all days in month
For datDay = dat1stMth To DateAdd("m", 1, dat1stMth) - 1
'find the top and left corner
lngTop = (DatePart("ww", datDay) - intStartWeek) * _
lngDayHeight + lngTopMargin
lngLeft = (Weekday(datDay) - 1) * lngDayWidth
If Weekday(datDay) = 1 Or Weekday(datDay) = 7 Then
Me.DrawWidth = 8
Else
Me.DrawWidth = 1
End If
'draw a rectangle for day
Me.Line (lngLeft, lngTop)-Step _
(lngDayWidth, lngDayHeight), , B
Me.CurrentX = lngLeft + 50
Me.CurrentY = lngTop + 50
Me.Print Day(datDay)
Next
End Sub
 
I apologize for the broad description. I'll try to explain more. My
database captures daily log reports completed by employees. I would
like to print a report in landscaped calendar format much like calendar
template in Corel. Within each cell(day) on the calendar will be log
writer(employee),shift, Case id etc. Please bear with me if you will
concerning the earlier suggestions...The code to print a blank calendar
did so, however, all did not fit on the page. I increased the detail
area as instructed but each time the last days were cut off. Should I
make adjustments to cell sizes within the code, and if so, will I also
need to create 42 labels? Perhaps I'm too green to attempt this. I
thought there would be an easy template style solution. Thank you for
responding.
 
Back
Top