Private Sub Ajout_Fériés()
'Liste Jours fériés en France
'01/01 01/05 08/05 14/07 15/08 01/11 11/11 25/12
'Lun pâques, lundi Pentecôte, jeudi Ascension
'Stop
If Month(Me.Tx_DateAct) = 1 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 1)).BackColor = RGB(0, 255, 0)
If Month(Me.Tx_DateAct) = 5 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 1)).BackColor = RGB(0, 255, 0)
If Month(Me.Tx_DateAct) = 5 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 8)).BackColor = RGB(0, 255, 0)
If Month(Me.Tx_DateAct) = 7 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 14)).BackColor = RGB(0, 255, 0) ': Exit Sub 'MsgBox Debtxt - 11 + 14
If Month(Me.Tx_DateAct) = 8 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 15)).BackColor = RGB(0, 255, 0)
If Month(Me.Tx_DateAct) = 11 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 1)).BackColor = RGB(0, 255, 0)
If Month(Me.Tx_DateAct) = 11 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 11)).BackColor = RGB(0, 255, 0)
If Month(Me.Tx_DateAct) = 12 Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + 25)).BackColor = RGB(0, 255, 0)
'Lundi Pâques'lundi de Paques =PAQ+1
'jeudi Ascension'Ascencion = PAQ + 39
'lundi Pentecôte'Lundi de pentecôte =PAQ+50
'MsgBox Paques(Year(Me.Tx_DateAct)) + 1
PAQ = Paques(Year(Me.Tx_DateAct)) + 1
Ascen = PAQ + 38
Pente = PAQ + 49
'Stop
'lun pâques
If Month(Me.Tx_DateAct) = Month(PAQ) Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + Day(PAQ))).BackColor = RGB(0, 255, 0)
'jeudi Ascension'Ascencion = PAQ + 39
If Month(Me.Tx_DateAct) = Month(Ascen) Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + Day(Ascen))).BackColor = RGB(0, 255, 0)
'lundi Pentecôte'Lundi de pentecôte =PAQ+50
If Month(Me.Tx_DateAct) = Month(Pente) Then Me.Controls("Label" & (11 + (Debtxt - 11) - 1 + Day(Pente))).BackColor = RGB(0, 255, 0)
End Sub
'http://blog.developpez.com/philben/p11431/vba-access/calculer-la-date-de-paques
Public Function Paques(ByVal an As Integer) As Date
'Calcul de la date du dimanche de Pâques à partir de l'année 325
'Performance par million d'appel :
' - Entre 325 et 1582 et entre 1900 et 2099 => 1/4 de seconde
' - Année supérieure à 1582 hors 1900 - 2099 => 1/2 de seconde
'Philben - v1.0 - Free to use
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer
If an < 10000 Then 'Limite supérieure des dates sous Access (31 décembre 9999)
Select Case an
Case 1900 To 2099 'Algorithme de Carter
a = (204 - 11 * (an Mod 19)) Mod 30 + 22
Paques = DateSerial(an, 3, a + 6 + (a > 49) - (an + an \ 4 + a + (a > 49)) Mod 7)
Case Is > 1582 'Proposé en 1876 dans la revue Nature (dérivé de l'algorithme de Delambre)
a = an Mod 19: b = an \ 100: c = an Mod 100
d = (19 * a + b - b \ 4 - (b - (b + 8) \ 25 + 1) \ 3 + 15) Mod 30
e = (32 + 2 * (b Mod 4) + 2 * (c \ 4) - d - c Mod 4) Mod 7
f = d + e - 7 * ((a + 11 * d + 22 * e) \ 451) + 114
Paques = DateSerial(an, f \ 31, f Mod 31 + 1)
Case Is > 324 'Algorithme de Oudin pour les dates juliennes < 1583 décrit par Claus Tondering
a = (19 * (an Mod 19) + 15) Mod 30
Paques = DateSerial(an, 3, 28 + a - (an + an \ 4 + a) Mod 7)
End Select
End If
End Function