Calculating the "Bank Holidays" between Dates

nilses

Registered User.
Local time
Today, 00:58
Joined
Jan 2, 2003
Messages
45
Hello,

I would like to have of the assistance on this function. This function calculate the bank holiday between two dates. When I insert this line in my query and that I wish to launch my query it posts me a window by indicating to me that it awaits a data to continue and I would like to know why?.

I call like this my function

essay:CompteJoursFeriés([tblJoursFériés];[DateJourFérié];[Date_Start];[Date_End])

Here my function

Function CompteJoursFeriés(rst As Recordset, strDateFérié As String, _
dhDébut As Date, dhFin As Date) As Integer

Dim rstNew As Recordset
Dim strFiltre As String
Dim strAncienFiltre As String
Dim intEnregistrements As Integer
Dim strSQL As String
On Error GoTo TraitementErreur

Set db = CurrentDb()
Set r = db.OpenRecordset("Jours chômés")

If Not rst Is Nothing Then
If Len(strDateFérié) > 0 Then
If Left(strDateFérié, 1) <> "[" Then
strDateFérié = "[" & strDateFérié & "]"
End If
strFiltre = strDateFérié & " BETWEEN #" & dhDébut & "# AND #" & dhFin & "#"
strAncienFiltre = rst.Filter
rst.Filter = strFiltre
Set rstNew = rst.OpenRecordset()
If rstNew.RecordCount > 0 Then
rstNew.MoveLast
intEnregistrements = rstNew.RecordCount
End If
' Pour ne pas compter à double un jour férié tombant sur un weekend
rstNew.MoveFirst
Do While Not rstNew.EOF
If EstWeekend(rstNew!DateJourFérié) Then
intEnregistrements = intEnregistrements - 1
End If
rstNew.MoveNext
Loop
rstNew.Close
End If
End If
TraitementFinal:
CompteJoursFeriés = intEnregistrements
Exit Function
TraitementErreur:
Resume TraitementFinal
End Function

Thanks for your help

Nilses
 
Here's another Bank Holiday function I've done:

This one calculates the date of Easter so that I can exclude Easter-2 and Easter+1 from the British working days:

Code:
Function DateOfEaster(ByVal intYear As Integer) As Date

    On Error GoTo Err_DateOfEaster
    
    ' Author: Mile-O-Phile (changed for some anonymity)
    ' Discussion: This function is designed to return the date of Easter on any given year within the
    '             range 1900 to 2099. It calculates the Epact - which is the age of the moon -
    '             diminished by one day. The Epact can can vary between 0 and 29. Firstly, however, it
    '             calculates the Dominical letter - a letter that has a cycle of 28 years with each century,
    '             despite the actual cycle of years taking 400 years to complete.

    ' Input(s): intYear - the year value for which the user wishes to calculate Easter
    ' Process: get the Dominical and modify it until it meets criteria
    '          calculate the Epact
    '          calculate Q
    ' Output(s): DateOfEaster- the exact date of Easter for a given year (as a date)

    Dim intDominical As Integer, intEpact As Integer, intQuote As Integer
    
    intDominical = 225 - (11 * (intYear Mod 19))
    
    ' if the Dominical is greater than 50 then subtract multiples of 30 until the resulting
    ' new value of it is less than 51
    If intDominical > 50 Then
        While intDominical > 50
            intDominical = intDominical - 30
        Wend
    End If
    
    ' if the Dominical is greater than 48 subtract 1 from it
    If intDominical > 48 Then intDominical = intDominical - 1
    
    intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7
    
    intQuote = intDominical + 7 - intEpact
    
    ' if the quote is less than 32 then Easter is in March
    ' if the quote is greater than 31 then the quote minus 31 is its date in April
    If intQuote > 31 Then
        DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
    Else
        DateOfEaster = DateSerial(intYear, 3, intQuote)
    End If

Exit_DateOfEaster:
    Exit Function

Err_DateOfEaster:
    MsgBox Err.Number & Err.Description
    Resume Exit_DateOfEaster

End Function
 
Last edited:
Very interesting.

Here's the one I use. Can't say that I really understand the math--just did the coding based on the source listed. It's proven to be accurate for any purposes I've needed.
Code:
Function Easter(pYear As Long) As Date
'*******************************************
'Name:      Easter (Function)
'Purpose:   Calculates the date Easter falls on
'           in a given year (Gregorian Calendar)
'Source:    [url]http://www.landfield.com/faqs/astronomy/faq/part3/section-11.html[/url]
'Coded by:  raskew
'Inputs:    ? Easter(2001)
'Output:    4/15/01
'*******************************************

Dim C, H, G, datehold, FM, theYear
theYear = DateSerial(pYear, 1, 1)
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
 

Users who are viewing this thread

Back
Top Bottom