Version 1
Public Function paques(annee) ‘ détermination de la date de Pâques en fonction de l’année
Dim var1, var2, var3, var4, var5, var6, var7
var1 = annee Mod 19 + 1
var2 = (annee \ 100) + 1
var3 = ((3 * var2) \ 4) – 12
var4 = (((8 * var2) + 5) \ 25) – 5
var5 = ((5 * annee) \ 4) – var3 – 10
var6 = (11 * var1 + 20 + var4 – var3) Mod 30
If (var6 = 25 And var1 > 11) Or (var6 = 24) Then var6 = var6 + 1
var7 = 44 – var6
If var7 < 21 Then var7 = var7 + 30
var7 = var7 + 7
var7 = var7 – (var5 + var7) Mod 7
If var7 <= 31 Then
paques = DateValue(CStr(var7) & « /3/ » & CStr(annee))
Else
paques = DateValue(CStr(var7 – 31) & « /4/ » & CStr(annee))
End If
End Function
Autres dates dans l’année. Presque toutes les mobiles découlent de Pâques:
(le code est vérolé, c’est juste pour connaître les dates)
TabDate(1, 1) = CDate(« 01/01/ » & AnneeEc): TabDate(1, 2) = « Jour de l’an »
TabDate(2, 1) = DatePaques: TabDate(2, 2) = « Pâques »
TabDate(3, 1) = DatePaques + 1: TabDate(3, 2) = « Lundi de Pâques »
TabDate(4, 1) = CDate(« 01/05/ » & AnneeEc): TabDate(4, 2) = « Fête du travail »
TabDate(5, 1) = CDate(« 08/05/ » & AnneeEc): TabDate(5, 2) = « Victoire 1945 »
TabDate(6, 1) = DatePaques + 39: TabDate(6, 2) = « Ascension »
TabDate(7, 1) = DatePaques + 49: TabDate(7, 2) = « Lundi de Pentecôte »
TabDate(8, 1) = CDate(« 14/07/ » & AnneeEc): TabDate(8, 2) = « Fête Nationale »
TabDate(9, 1) = CDate(« 15/08/ » & AnneeEc): TabDate(9, 2) = « Assomption »
TabDate(10, 1) = CDate(« 01/11/ » & AnneeEc): TabDate(10, 2) = « Toussaint »
TabDate(11, 1) = CDate(« 11/11/ » & AnneeEc): TabDate(11, 2) = « Armistice 1918 »
TabDate(1, 1) = CDate(« 25/12/ » & AnneeEc): TabDate(12, 2) = « Noël »
If chkAlsaciens = Checked Then
TabDate(13, 1) = DatePaques – 2: TabDate(13, 2) = « Vendredi Saint »
TabDate(14, 1) = CDate(« 26/12/ » & AnneeEc): TabDate(14, 2) = « Etienne »
Else
TabDate(13, 2) = « »
TabDate(14, 2) = « »
End If
dte = DateSerial(AnneeEc, 1, 8): TabFeteMobile(1, 1) = « Epiphanie »: TabFeteMobile(1, 2) = DateSerial(Year(dte), Month(dte), Day(dte) – DatePart(« w », dte) + 1)
TabFeteMobile(2, 1) = « Mardi gras »: TabFeteMobile(2, 2) = DatePaques – 47
TabFeteMobile(3, 1) = « Cendres »: TabFeteMobile(3, 2) = DatePaques – 46
TabFeteMobile(4, 1) = « Carême »: TabFeteMobile(4, 2) = DatePaques – 42
TabFeteMobile(5, 1) = « Rameaux »: TabFeteMobile(5, 2) = DatePaques – 7
TabFeteMobile(6, 1) = « Vendredi Saint »: TabFeteMobile(6, 2) = DatePaques – 2
TabFeteMobile(7, 1) = « Souv. Déportés »: TabFeteMobile(7, 2) = DatePaques + 7
dte = DateSerial(AnneeEc, 6, 0): DernierDimanche = DateSerial(Year(dte), Month(dte), Day(dte) – DatePart(« w », dte) + 1)
TabFeteMobile(8, 1) = « Fête des Mères »: TabFeteMobile(8, 2) = DernierDimanche
TabFeteMobile(9, 1) = « Fête des Pères »: TabFeteMobile(9, 2) = DernierDimanche + 21
TabFeteMobile(10, 1) = « Trinité »: TabFeteMobile(10, 2) = DatePaques + 56
TabFeteMobile(11, 1) = « Fête-Dieu »: TabFeteMobile(11, 2) = DatePaques + 63
TabFeteMobile(12, 1) = « Sacré-Coeur »: TabFeteMobile(12, 2) = DatePaques + 68
dte = DateSerial(AnneeEc, 12, 25): JourAvent = DateSerial(Year(dte), Month(dte), (Day(dte) – 21) – DatePart(« w », dte) + 1)
TabFeteMobile(13, 1) = « Christ Roi »: TabFeteMobile(13, 2) = JourAvent – 7
TabFeteMobile(14, 1) = « Avent »: TabFeteMobile(14, 2) = JourAvent
Version 2
Public Function calcul(ByVal j As Long, ByVal m As Long, ByVal a As Long) As Long
‘Calculer nombre jours depuis le 01/01/0001
Dim var1 As Long, var2 As Long
If (m <= 2) Then
m = m + 12
a = a – 1
End If
var1 = a \ 100
var2 = 2 – var1 + (var1 \ 4)
calcul = Int(365.25 * a) + Int(30.6001 * (m + 1)) + j + var2 – 430
End Function
Public Function quantieme(ByVal j As Integer, ByVal m As Integer, ByVal a As Integer) As Integer
‘Calcul nombre de Jours depuis debut Annee
quantieme = (calcul(j, m, a) – calcul(1, 1, a) + 1)
End Function
Public Function bissextile(ByVal annee As Long) As Boolean
‘Determiner si Annee Bissextile
If ((annee Mod 400) = 0 Or ((annee Mod 4) = 0 And (annee Mod 100) <> 0)) Then
bissextile = True
End If
End Function
Public Function calculpaques(ByVal annee As Integer) As Integer
‘Calculer date de Paques
Dim r01 As Integer, r02 As Integer, r03 As Integer, r04 As Integer
Dim r05 As Integer, r06 As Integer, r07 As Integer, r08 As Integer
Dim r09 As Integer, r10 As Integer, r11 As Integer, r12 As Integer
r01 = annee Mod 19
r02 = annee \ 100
r03 = annee Mod 100
r04 = r02 \ 4
r05 = r02 Mod 4
r06 = (r02 + 8) \ 25
r07 = (r02 + 1 – r06) \ 3
r08 = 15 + 19 * r01 + r02 – r04 – r07
r08 = r08 Mod 30
r09 = r03 \ 4
r10 = r03 Mod 4
r11 = 32 + 2 * (r05 + r09) – r08 – r10
r11 = r11 Mod 7
r12 = (r01 + 11 * r08 + 22 * r11) \ 451
calculpaques = quantieme(21, 3, annee) + r08 + r11 – 7 * r12 + 1
End Function
Public Function semaine(ByVal j As Integer, ByVal m As Integer, ByVal a As Integer) As String
‘Calcul numero de la Semaine
Dim Toto As String
Toto = Format(Format(DateSerial(a, m, j), « ww », vbMonday, vbFirstFourDays), « @@ »)
If Toto = « 53 » And j > 28 Then semaine = » 1″ Else semaine = Toto
End Function
Public Function ferie(ByVal j As Integer, ByVal m As Integer, ByVal a As Integer) As Boolean
‘Déterminer si Jour Ferié
‘FERIES DATES FIXES
‘Nouvel an
If (j = 1 And m = 1 And a >= 1811) Then ferie = True
‘Fête du travail
premiermai = quantieme(1, 5, a)
If (j = 1 And m = 5 And a >= 1947) Then ferie = True
‘Victoire 1945
huitmai = quantieme(8, 5, a)
If (j = 8 And m = 5 And a >= 1986) Then ferie = True
‘Fête nationale
quatorzejuil = quantieme(14, 7, a)
If (j = 14 And m = 7 And a >= 1880) Then ferie = True
‘Assomption
If (j = 15 And m = 8 And a >= 1802) Then ferie = True
‘Toussaint
If (j = 1 And m = 11 And a >= 1802) Then ferie = True
‘Armistice 1418
onzenovembre = quantieme(11, 11, a)
If (j = 11 And m = 11 And a >= 1922) Then ferie = True
‘Noël
If (j = 25 And m = 12 And a >= 1802) Then ferie = True
‘FERIES DATES MOBILES
‘Lundi de Pâques
lundipaques = calculpaques(annee) + 1
If (quantieme(j, m, a) = lundipaques And a >= 1886) Then ferie = True
‘Lundi de la Pentecôte
lundipentecote = lundipaques – 1 + 50
If (quantieme(j, m, a) = lundipentecote And a >= 1886) Then ferie = True
‘Ascension
ascension = lundipaques – 1 + 39
If (quantieme(j, m, a) = ascension And a >= 1802) Then ferie = True
‘Autres Fêtes – Jours non Feriés
epiphanie = 8 – (calcul(1, 1, annee) Mod 7)
paques = lundipaques – 1
pentecote = paques + 49
careme = paques – 42
mardigras = careme – 5
cendres = mardigras + 1
rameaux = paques – 7
fetedieu = paques + 63
vendredisaint = paques – 2
End Function