- Code : Tout sélectionner
Function DatesJoursFeries( LaDate )
'À partir de l'année de la date passée en paramètre :
'- calcul les dates des jours fériés mouvants
'- crée les dates des jours fériés fixes
Dim annee As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim moisPaques As Integer
Dim jourPaques As Integer
Dim Paques As NotesDateTime
Dim LundiPaques As NotesDateTime
Dim Ascension As NotesDateTime
Dim Pentecote As NotesDateTime
Dim LundiPentecote As NotesDateTime
Dim JourAn As NotesDateTime
Dim premierMai As NotesDateTime
Dim huitMai As NotesDateTime
Dim quatorzeJuillet As NotesDateTime
Dim quinzeAout As NotesDateTime
Dim premierNovembre As NotesDateTime
Dim onzeNovembre As NotesDateTime
Dim noel As NotesDateTime
'Calcul la date de Pâques (catholique)
'Pour info : premier dimanche qui suit la première pleine lune du printemps
annee% = Year( LaDate )
a% = Int(annee%/100)
b% = annee%-19*Int(annee%/19)
c% =Int((a%-17)/25)
d% = a%-Int(a%/4)-Int((a%-c%)/3)+19*b%+15
e% = d%-30*Int(d%/30)
f% = e%-Int(e%/28)*(1-Int(e%/28)*Int(29/(e%+1))*Int((21-b%)/11))
g% = annee%+Int(annee%/4)+f%+2-a%+Int(a%/4)
h = g%-7*Int(g%/7)
i =f%-h%
moisPaques% =3+Int((i%+40)/44)
jourPaques% = i%+28-31*Int(moisPaques%/4)
'Affecte les dates
Set Paques = New NotesDateTime( Cstr( Datenumber( annee% , moisPaques% , jourPaques%) ) )
Set LundiPaques = New NotesDateTime( Cstr( Datenumber( annee% , moisPaques% , jourPaques%+1) ) )
'Ascension : Pâques + 39 jours
Set Ascension = New NotesDateTime( Cstr( Datenumber( annee% , moisPaques% , jourPaques%+39 ) ) )
'Pentecôte : Paques + 49 jours
Set Pentecote = New NotesDateTime( Cstr( Datenumber( annee% , moisPaques% , jourPaques%+49) ) ) '
Set LundiPentecote = New NotesDateTime( Cstr( Datenumber( annee% , moisPaques% , jourPaques%+50) ) )
Set JourAn = New NotesDateTime( "01/01/"&Cstr( annee%) )
Set premierMai = New NotesDateTime( "01/05/"&Cstr( annee%) )
Set huitMai = New NotesDateTime( "08/05/"&Cstr( annee%) )
Set quatorzeJuillet = New NotesDateTime( "14/07/"&Cstr( annee%) )
Set quinzeAout = New NotesDateTime( "15/08/"&Cstr( annee%) )
Set premierNovembre = New NotesDateTime( "01/11/"&Cstr( annee%) )
Set onzeNovembre = New NotesDateTime( "11/11/"&Cstr( annee%) )
Set noel = New NotesDateTime( "25/12/"&Cstr( annee%) )
'Crée un tableau (array) avec les dates (NE PAS CHANGER L'ORDRE)
'- 1 à 8 : fériés fixes
'- 9 à 13 : fériés mouvants
Dim datesJF( 1 To 13 )
datesJF( 1 ) = JourAn.dateOnly
datesJF(2) = premierMai.dateOnly
datesJF(3) = huitMai.dateOnly
datesJF(4) = quatorzeJuillet.dateOnly
datesJF(5) = quinzeAout.dateOnly
datesJF(6) = premierNovembre.dateOnly
datesJF(7) = onzeNovembre.dateOnly
datesJF(8) = Noel.DateOnly
datesJF(9) = Paques.dateOnly
datesJF(10) = LundiPaques.dateOnly
datesJF(11) = Ascension.DateOnly
datesJF(12) = Pentecote.dateOnly
datesJF(13) = LundiPentecote.dateOnly
'Valeur retounée par la fonction = liste de dates
DatesjoursFeries = datesJF
End Function
* Rappel : une année bissextile, n'est pas une année qui à (ou qui aime) les deux sexes...