The Calender (1 Viewer)

[Oldsoftboss]

Is there a way of changing the colors of individual dates in the calender?
Say weekends blue numbers and weekdays another color then public holidays another.
Dave

 

[dynamictiger]

I am guessing you want to show these dates as different colours to prevent their use, or highlight they are weekends and people don't work weekends.

I do not know how to colour the dates as you suggest, however, i did come up with a solution of sorts.

Use the weekday function to dictate whether a day is available this allows Monday to Friday.

Public Holidays I am still playing with, however, I think the solution is to store the week number and day they usually occur, or as is the case with Christmas the date they occur. The only problem one I see is Easter as I am not sure how this is calculated.

As I am using the calendar for staff schedules, I have also written an override. This is so staff can work saturday, sundays or public holidays if the need arises.

 

[Oldsoftboss]

DynamicTiger
Thanks for you reply.
The reason for the color change was to try to prevent the boss booking in work in advance,(on a public holiday) and then no one being there to do it!
Until I can suss out the calendar I've created a hidden tab page on my form and entered the public holiday dates, then in the 'on click' event on the calendar put a message box to compare the date with the public holidays and Then MsgBox "This day is such & such a holiday" Hopfully we wont get the general public ringing up say "where were you?"

 

[directormac]

I'm working on something now that requires the ever-popular "check for public holidays" routine as well. I've seen several replies where people have a table populated with days off, but I'm leary of doing that, becuase it means someone has to keep adding future days. Here's what I've got so far (only works through 2020, due to Easter), perhaps it will serve as a useful starting point for you...

--Still-Learning Mac


Public Function boolValidDate(dtmTarget As Date)
' PURPOSE: To see if the the argument dtmTarget is a valid workday or not.
' ARGUMENTS: dtmTarget = Date to be checked.
' RETURNS: Boolean TRUE (valid workday) or FALSE (day off, office closed).
' EXAMPLE: If (boolValidDate(Now()) = True Then...
' REVISION: 01/17/2002 Mac Brought over into XSit from previous version of Mac's TraXBS.
' 01/24/2002 Altered to make use of boolCheckDayOfMonth function.

boolValidDate = True ' start by assuming it IS a valid workday, then eliminate the days that aren't.

' check for weekends...
If Weekday(dtmTarget, vbMonday) = 7 Then boolValidDate = False ' NO sunday is valid
If Weekday(dtmTarget, vbMonday) = 6 Then boolValidDate = False ' NO saturday is valid

' check for regular holidays...
If DatePart("m", dtmTarget) = 1 And DatePart("d", dtmTarget) = 1 Then boolValidDate = False ' new year's day
If DatePart("m", dtmTarget) = 6 And DatePart("d", dtmTarget) = 14 Then boolValidDate = False ' flag day
If DatePart("m", dtmTarget) = 7 And DatePart("d", dtmTarget) = 4 Then boolValidDate = False ' independence day
If DatePart("m", dtmTarget) = 11 And DatePart("d", dtmTarget) = 11 Then boolValidDate = False ' veteran's day
If DatePart("m", dtmTarget) = 12 And DatePart("d", dtmTarget) = 24 Then boolValidDate = False ' christmas eve
If DatePart("m", dtmTarget) = 12 And DatePart("d", dtmTarget) = 25 Then boolValidDate = False ' christmas day

' check for moving holidays...
' MLK day - third monday of every january...
If boolCheckDayOfMonth(dtmTarget, 3, 1, 1) = True Then boolValidDate = False
' president's day - 3rd monday of every february...
If boolCheckDayOfMonth(dtmTarget, 3, 1, 2) = True Then boolValidDate = False
' memorial day - last monday in may
If boolCheckDayOfMonth(dtmTarget, -1, 1, 5) = True Then boolValidDate = False
' labor day - first monday in sept...
If boolCheckDayOfMonth(dtmTarget, 1, 1, 9) = True Then boolValidDate = False
' columbus day - second monday in october
If boolCheckDayOfMonth(dtmTarget, 2, 1, 10) = True Then boolValidDate = False
' thanksgiving - 4th thursday of every november...
If boolCheckDayOfMonth(dtmTarget, 4, 4, 11) = True Then boolValidDate = False
' fri after t-giving is a holiday most places, 4th friday of november...
If boolCheckDayOfMonth(dtmTarget, 4, 5, 11) = True Then boolValidDate = False

' easter - the "formula" for this one involves full moons and the vernal equinox, so...
If dtmTarget = #3/31/2002# Then boolValidDate = False
If dtmTarget = #4/20/2003# Then boolValidDate = False
If dtmTarget = #4/11/2004# Then boolValidDate = False
If dtmTarget = #3/27/2005# Then boolValidDate = False
If dtmTarget = #4/16/2006# Then boolValidDate = False
If dtmTarget = #4/8/2007# Then boolValidDate = False
If dtmTarget = #3/23/2008# Then boolValidDate = False
If dtmTarget = #4/12/2009# Then boolValidDate = False
If dtmTarget = #4/4/2010# Then boolValidDate = False
If dtmTarget = #4/24/2011# Then boolValidDate = False
If dtmTarget = #4/8/2012# Then boolValidDate = False
If dtmTarget = #3/31/2013# Then boolValidDate = False
If dtmTarget = #4/20/2014# Then boolValidDate = False
If dtmTarget = #4/5/2015# Then boolValidDate = False
If dtmTarget = #3/27/2016# Then boolValidDate = False
If dtmTarget = #4/16/2017# Then boolValidDate = False
If dtmTarget = #4/1/2018# Then boolValidDate = False
If dtmTarget = #4/21/2019# Then boolValidDate = False
If dtmTarget = #4/12/2020# Then boolValidDate = False
' good friday is based on easter, so another laundry list <sigh>...
' If dtmTarget = #3/29/2002# Then boolValidDate = False
' If dtmTarget = #4/18/2003# Then boolValidDate = False
' If dtmTarget = #4/9/2004# Then boolValidDate = False
' If dtmTarget = #3/25/2005# Then boolValidDate = False
' If dtmTarget = #4/14/2006# Then boolValidDate = False
' If dtmTarget = #4/6/2007# Then boolValidDate = False
' If dtmTarget = #3/21/2008# Then boolValidDate = False
' If dtmTarget = #4/10/2009# Then boolValidDate = False
' If dtmTarget = #4/2/2010# Then boolValidDate = False
' If dtmTarget = #4/22/2011# Then boolValidDate = False
' If dtmTarget = #4/6/2012# Then boolValidDate = False
' If dtmTarget = #3/29/2013# Then boolValidDate = False
' If dtmTarget = #4/18/2014# Then boolValidDate = False
' If dtmTarget = #4/3/2015# Then boolValidDate = False
' If dtmTarget = #3/25/2016# Then boolValidDate = False
' If dtmTarget = #4/14/2017# Then boolValidDate = False
' If dtmTarget = #3/29/2018# Then boolValidDate = False
' If dtmTarget = #4/19/2019# Then boolValidDate = False
' If dtmTarget = #4/10/2020# Then boolValidDate = False

End Function ' end of boolValidDate

----------------------------------

Public Function boolCheckDayOfMonth(dtmTargetDate As Date, intTargetNumber As Integer, intTargetDay As Integer, intTargetMonth As Integer)
' PURPOSE: Determine if the target date is the <number> occurance of <weekday> within <month>
' This will be used in determining valid workdays. See boolCheckValidDate
' ARGUMENTS: intTargetNumber = the frequency of the day we are check for, i.e. 4 = 4th <weekday> of <month>
' intTargetDay = The day of the week, i.e. 1 = <number>th Monday of <month>
' intTargetMonth = Month to check within, i.e. 11 = <number>th <weekday> of November
' NOTE: if you pass -1 as the TargetNumber, the function looks for the LAST occurance,
' regardless of the number of times that day occurs in the month.
' RETURNS: True if <target date> IS the <number> occurance of <weekday> within <month>, otherwise false
' EXAMPLE: boolCheckDayOfMonth(Date(),3,5,8) will return true if today is the third Friday in August.
' REVISION: 01/24/2002 MAC created function.

boolCheckDayOfMonth = False ' start by assuming a FALSE return - the target date is NOT the target occurance

' PART ONE = initial checks. Can we skip the detailed checks?
If DatePart("w", dtmTargetDate, vbMonday) <> intTargetDay Then Exit Function ' if the day doesn't match, we're done
If DatePart("m", dtmTargetDate) <> intTargetMonth Then Exit Function ' likwise the month
' END PART ONE

' PART TWO = determine what date the Nth <day> of <month> actually IS for a positive occurance...
If intTargetNumber > 0 Then
Let boolTempBool = False
Let intTempCount = 0
Let dtmTempDate = Format(findfirst(dtmTargetDate), "Short Date") ' start on the first day of the target month
Do While boolTempBool = False ' while we haven't found our target occurance of our target day...
' if it's our target day of the week, count it...
If Weekday(dtmTempDate, vbMonday) = intTargetDay Then
intTempCount = intTempCount + 1
End If
' if it's our target occurance, we're done counting...
If intTempCount = intTargetNumber Then
boolTempBool = True
dtmTempDate = DateAdd("d", -1, dtmTempDate) ' move back to compensate for frwrd move
End If
dtmTempDate = DateAdd("d", 1, dtmTempDate) ' move forward one day...
Loop ' and repeat the loop.
End If
' END PART TWO

' PART THREE = determine date of LAST occurance of day for a negative occurance argument
If intTargetNumber < 0 Then
Let dtmTempDate = Format(findfirst(dtmTargetDate), "Short Date") ' start on the first day of the target month
Let dtmDateCounter = dtmTempDate ' we need a separate counter this time
Do While DatePart("m", dtmDateCounter) = DatePart("m", dtmTargetDate) ' while we're still in the target month...
' if the counter has hit the target day of the week, update the temp date
If Weekday(dtmDateCounter, vbMonday) = intTargetDay Then
dtmTempDate = dtmDateCounter
End If
dtmDateCounter = DateAdd("d", 1, dtmDateCounter)
Loop ' repeat the loop until we've exceeded the target month
End If
' END PART THREE

' PART FOUR: check to determine if the date of the target occurance is our target date...
dtmTempDate = Format(dtmTempDate, "Short Date")
If dtmTempDate = dtmTargetDate Then boolCheckDayOfMonth = True
' END PART FOUR

End Function ' end of boolCheckDayOfMonth

Public Function findfirst(dtmSeek As Date) As Date
' ARGUMENT: dtmSeek
' RETURNS: date value of 8:00 am on the first day of the month of <dtmSeek>

findfirst = Format(dtmSeek, "mm/""01""/yyyy ""8:00:00 am")

End Function

 

[raskew]

Here's Easter:

Function Easter(theyear As Date) As Date
'*******************************************
'Name: Easter (Function)
'Purpose: Calculates the date Easter falls on
' in a given year (Gregorian Calendar)
'Source: http://www.landfield.com/faqs/astronomy/faq/part3/section-11.html
'CreatedBy: raskew
'Date: March 18, 2001
'Inputs: ? Easter(#1/1/01#) 'the month and day are not important
'Output: 4/8/01
'*******************************************

Dim C, H, G, DateHold, FM

G = (year(theyear) Mod 19) + 1
H = Int(year(theyear) / 100)
C = -H + Int(H / 4) + Int(8 * (H + 11) / 25)
DateHold = DateSerial(year(theyear), 4, 19)
FM = DateHold - ((11 * G + C) Mod 30)
FM = IIf(Month(FM) = 4 And Day(FM) = 19 And G >= 12, FM - 2, FM)
FM = IIf(Month(FM) = 4 And Day(FM) = 19, FM - 1, FM)
Easter = FM + 7 - WeekDay(FM) + 1

End Function