Module Help

[FREDDY67]

Morning

I am new to Modules & after some advice, I have a appointment db where the appointments & holidays are displayed on a calendar. I am currently formatting the calendar for bank holidays in the following manner;

If (intPubMyYear = 2009) Then
If (intPubMonth = 5) Then
If (intDay = 25) Then

The numerical date values are stored in a table, I believe it is possible to store these values in a Module instead of having to enter each format value manually. Can someone please point me in the right direction as how I go about this or what I should be searching for, I am running access 2007.

Any assistance would be greatly appreciated.

Thanks

Freddy

 

[HiTechCoach]

Are you storing the holidays in a table in a date field?

 

[FREDDY67]

HiTechCoach

They are currently stored in both a date field & 3 other numerical fields representing Days/Months/Years, I have both as I thought I may need the seperate fields.

Thanks
Freddy

 

[HiTechCoach]

If you have a date/time data type field, to get the parts you need, use the built-in functions:

Day(), Month(), Year()

To follow the rules of normalization, you would not store both the data and also the extracted parts since they can be calculated as needed.

I like to store all variable data in tables whenever possible. This way I can update an application without have to make any design changes to the front end and have to complie a new MDE/ACCDE. This way you avoid any "hard coding" when possible.

 

[FREDDY67]

HiTechCoach

Thanks for the info, I can soon delete the the 3 additional fields, but I think I my question may have been misleading. I would like to know how I get the date information into the formatting criteria, this is all the code behind the calendar but no matter what I try I can't pull the data from the table into the formatting criteria;

Public intPubMonth, intPubMyYear 'The big calendar's current month & year

Private Function DayDoubleClicked(intDayClicked As Integer)
Dim dteMyDate As Date

' Reset intDayClicked to equal the value of the date in the BoxZ control -
' where Z is the actual date and not just the numeric value of the control name
intDayClicked = Me("box" & Mid(Screen.ActiveControl.Name, 4)).Value
dteMyDate = DateSerial(intPubMyYear, intPubMonth, intDayClicked)
txtdateLUp = dteMyDate
DoCmd.OpenForm "frmAppt"
End Function

Private Function DayDoubleClicks(intDayClicked As Integer)
Dim dteMyDate As Date

' Reset intDayClicked to equal the value of the date in the BoxZ control -
' where Z is the actual date and not just the numeric value of the control name
intDayClicked = Me("box" & Mid(Screen.ActiveControl.Name, 5)).Value
dteMyDate = DateSerial(intPubMyYear, intPubMonth, intDayClicked)
txtdateLUp = dteMyDate
DoCmd.OpenForm "frmApptWk"
End Function
Private Sub cboAppt_Change()
Call DisplayMeetings
cmdDud.SetFocus
End Sub

Private Sub CMDCLS_Click()
DoCmd.Close acForm, "frmCalendarApp"
End Sub


Private Sub Form_Current()
Call DisplayMeetings
End Sub

Private Sub Form_Load()
DoCmd.MoveSize 0.5 * 1400, 1 * 1400, 10.7 * 1400, 7.5 * 1400
End Sub

' When the form is opened, check for passed
' arguments. If there are some, set the
' month/date to be the passed date and if not,
' use the current month/date.

Private Sub Form_Open(Cancel As Integer)

If IsNull(Me.OpenArgs) Then
' Use today's date
intPubMyYear = Year(Date)
intPubMonth = Month(Date)
Else
' Use passed arguments...
intPubMyYear = Year(Me.OpenArgs)
intPubMonth = Month(Me.OpenArgs)
End If

Call SetDates
Call DisplayMeetings

End Sub

Private Sub Next_Click()

' Display the next month
intPubMonth = intPubMonth + 1

If intPubMonth = 13 Then
intPubMonth = 1
intPubMyYear = intPubMyYear + 1
End If

Call SetDates
Call DisplayMeetings

End Sub

Private Sub Previous_Click()

' Display the previous month
intPubMonth = intPubMonth - 1

If intPubMonth = 0 Then
intPubMonth = 12
intPubMyYear = intPubMyYear - 1
End If

Call SetDates
Call DisplayMeetings

End Sub

Public Sub SetDates()
' Set up the day numbers on the calendar form, based on the month to be displayed
Dim strdate As Date
Dim r As Integer
Dim intFirstDay As Integer
Dim intLastDay As Integer
Dim intDay As Integer
Dim strDay As String


' Clear the text from the calendar boxes and make them white
For r = 1 To 42
Me("Box" & Trim$(r)) = "" 'Empty number box
Me("Box" & Trim(r)).BackColor = "10921638"
Me("Box" & Trim(r)).Visible = True
Me("Day" & Trim$(r)) = "" 'Empty day box
Me("Day" & Trim(r)).BackColor = "13092807"
Me("cmd" & Trim(r)).Enabled = True
Me("cmds" & Trim(r)).Enabled = True

' Hide the rarely-used sixth row of calendar boxes
If r > 35 Then
Me("Box" & Trim(r)).Visible = False
Me("Day" & Trim(r)).Visible = False
Me("cmd" & Trim(r)).Enabled = False
Me("cmds" & Trim(r)).Enabled = False
End If

Next r

' Update the month name - thanks to CyberCow for this fix
'Me.txtMonth.Caption = Format(intPubMonth, "mmmm") & " " & intPubMyYear
Me.txtMonth.Caption = Format(DateSerial(intPubMyYear, intPubMonth, 1), "mmmm yyyy")

' Get first day of the month.
intFirstDay = WeekDay(DateSerial(intPubMyYear, intPubMonth, 1))

' Day of the current box.
intDay = 2 - intFirstDay

' First day of this month, in date format
strdate = DateSerial(intPubMyYear, intPubMonth, 1)

' Last date of this month (January=31, June=30, etc.)
intLastDay = DateSerial(Year(strdate), Month(strdate) + 1, Day(strdate)) _
- DateSerial(Year(strdate), Month(strdate), Day(strdate))

' Cycle through the boxes, making useable days grey and unsed days background.
For r = 1 To 42
strDay = "Box" & Trim(r)
' If this box is before the first day,
' or if this box is after the last day, make it grey.
If intDay < 1 Or intDay > intLastDay Then
Me(strDay).BackColor = "6710886"
Me(strDay).Visible = False
Me("Day" & Trim(r)).BackColor = "15066597"
Me("Day" & Trim(r)).Enabled = False 'Don't let them click a grey box
Me("cmd" & Trim(r)).Enabled = False
Me("cmds" & Trim(r)).Enabled = False
Else
' If necessary, unhide boxes on the rarely-used 6th row
If r > 35 Then
Me(strDay).Visible = True
Me(strDay).BackColor = "10921638"
Me("Day" & Trim(r)).Visible = True
Me("Day" & Trim(r)).BackColor = "13092807"
Me("Day" & Trim(r)).Enabled = True 'Clickable day
Me("cmd" & Trim(r)).Enabled = True
Me("cmds" & Trim(r)).Enabled = True
End If
' Put the day number in the little box in the upper corner of the day
Me(strDay) = intDay

' If this box is TODAY's date, paint the number box Blue!
If (intPubMonth = Month(Date)) Then
If (intDay = Day(Date)) Then
Me("Box" & Trim(r)).BackColor = "0"
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 1) Then
If (intDay = 1) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 4) Then
If (intDay = 10) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 4) Then
If (intDay = 13) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 5) Then
If (intDay = 4) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 5) Then
If (intDay = 25) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 8) Then
If (intDay = 31) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 12) Then
If (intDay = 25) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 12) Then
If (intDay = 26) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2009) Then
If (intPubMonth = 12) Then
If (intDay = 28) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 1) Then
If (intDay = 1) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 4) Then
If (intDay = 2) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 4) Then
If (intDay = 5) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 5) Then
If (intDay = 3) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 5) Then
If (intDay = 31) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 8) Then
If (intDay = 30) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 12) Then
If (intDay = 25) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 12) Then
If (intDay = 26) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 12) Then
If (intDay = 27) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
If (intPubMyYear = 2010) Then
If (intPubMonth = 12) Then
If (intDay = 28) Then
Me("Day" & Trim(r)).BackColor = "6710886"
Me("Day" & Trim(r)).FontBold = True
Me("Day" & Trim(r)).ForeColor = "15921906"
Me(strDay).BackColor = "6710886"
Me("Day" & Trim(r)).TextAlign = 2
End If
End If
End If
End If
intDay = intDay + 1
Next r
For r = 1 To 37 ' dbl-checks the enabling of whited boxes
If Me("Day" & Trim(r)).BackColor = "5711495" Then Me("Day" & Trim(r)).Enabled = True
Next r
End Sub

Public Sub DisplayMeetings()
' Add any meetings that occur this month to the proper day box on the form
Dim strSQL As String
Dim intTemp As Integer
Dim intDays(37) As Integer
Dim strDays(31) As String
Dim strAppt As String
Dim strApptStartTime As String
Dim strApptEndTime As String
Dim strApptWithInit As String
Dim strApptWith As String
Dim strApptDate As String
Dim r As Integer
Dim rst

' To start, clear all meetings from every day
For r = 1 To 37
Me("Day" & Trim$(r)) = ""
Next r

' Grab this month's meetings from the tblAppointments table
strSQL = "SELECT tblAppointments.* " & _
"FROM tblAppointments " & _
"WHERE Month([ApptDate])= " & intPubMonth & " AND Year([ApptDate]) = " & intPubMyYear & " AND [tblAppointments].[ApptWith] = '" & Me.txtappup & "'"
Set rst = CurrentDb.OpenRecordset(strSQL)

' Skip adding appointments if there are none for this month
If rst.RecordCount > 0 Then

' Populate array intDays(r) with the day of the month (or zero if the box is unused)
For r = 1 To 37
If Me("Box" & Trim(r)) = "" Then
intDays(r) = 0
Else
intDays(r) = Me("Box" & Trim(r))
End If
Me("Day" & Trim(r)) = ""
Next r

rst.MoveFirst

Do While Not rst.EOF
' Grab the time, date and subject of each appointment
strApptStartTime = Format(rst!ApptStartTime, "hh:mm")
strApptDate = rst!ApptDate
' Truncate the appointment description
strAppt = Left(rst!Appt, 20)

' Get the day of the month for this appointment
intTemp = Day(rst!ApptDate)

' Add the appointment details to the proper day
strDays(intTemp) = strDays(intTemp) & vbCrLf & strAppt

rst.MoveNext
Loop

' Loop through every calendar box. If there are any appointments stored
' in array strDays(r), add them to the calendar box
For r = 1 To 37
If intDays(r) <> 0 Then
intTemp = intDays(r)
Me("Day" & Trim(r)) = strDays(intTemp)
End If
Next r
End If

rst.Close

End Sub


The section that includes the formatting is in blue, many thanks for your help.

Freddy

 

[HiTechCoach]

would it be possible to post a sample database so I can test the code?

 

[FREDDY67]

HiTechCoach

I have attached the db, all forms open through frmCalendarApp.

Thanks for your help.

Freddy

 

[HiTechCoach]

I have downloaded your database. I will take a look and get back to you.

 

[FREDDY67]

HiTechCoach

Thanks

Freddy

 

[HiTechCoach]

This looks like code I have work with from UtterAcess.com. Is that here you got it?

I looked and did not find any table that looked like it would hold the holidays.

I would create a table to hold all the holidays. I would create a routine similar to the DisplayMeetings() that loads the Holidays onto the calendar. I would add a call to this new SUB at the end of the SetDates().

 

[FREDDY67]

HiTechCoach

Sorry for the delay in replying, the code was from UtterAccess.com just adjusted for my needs. I created a new table & routine as you suggested & it works perfectly.

Thank you for taking the time to help me out, it is appreciated.

Many Thanks

Freddy

 

[HiTechCoach]

Freddy,

You're welcome!

Glad we could assist.