1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
| Option Explicit
Dim JFeries(10) As Long
Sub Tst()
Dim dDeb As Date, dFin As Date
Dim i As Long, samdim As Long, ferie As Long
samdim = 0: ferie = 0
dDeb = CDate(#4/1/2015#)
dFin = CDate(#4/30/2015#)
JoursFeries (2015)
For i = dDeb To dFin
If Weekday(i, vbMonday) > 5 Then samdim = samdim + 1
If EstFerie(i) Then ferie = ferie + 1
Next i
Debug.Print samdim, ferie
End Sub
Private Sub JoursFeries(An As Long)
Dim Nb As Long, Epacte As Long
Dim PLune As Date, LPaques As Date
Dim i As Long, j As Long, k As Long, tmp As Long
' Calcul du Lundi de Pâques
Nb = (An Mod 19) + 1
' Différence entre calendrier solaire et lunaire
Epacte = (11 * Nb - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
' Valable entre 1900 et 2199 : on verra bien ?
If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
' Lundi de Pâques
LPaques = PLune - Weekday(PLune) + vbMonday + 7
Erase JFeries
' Jour de l'An
JFeries(0) = DateSerial(An, 1, 1)
' Paques
JFeries(1) = LPaques
' Ascension
JFeries(2) = LPaques + 38
' Pentecôte
JFeries(3) = LPaques + 49
' Fete du travail
JFeries(4) = DateSerial(An, 5, 1)
' Anniversire 1945
JFeries(5) = DateSerial(An, 5, 8)
' Fete Nationale
JFeries(6) = DateSerial(An, 7, 14)
' Assomption
JFeries(7) = DateSerial(An, 8, 15)
' Toussaint
JFeries(8) = DateSerial(An, 11, 1)
' Armistice 1918
JFeries(9) = DateSerial(An, 11, 11)
' Noel
JFeries(10) = DateSerial(An, 12, 25)
' Tri Tableau JFeries()
For i = LBound(JFeries) To UBound(JFeries)
j = i
For k = j + 1 To UBound(JFeries)
If JFeries(k) <= JFeries(j) Then j = k
Next k
If i <> j Then
tmp = JFeries(j)
JFeries(j) = JFeries(i)
JFeries(i) = tmp
End If
Next i
End Sub
Private Function EstFerie(ByVal dDate As Date) As Boolean
Dim i As Long
EstFerie = False
For i = LBound(JFeries) To UBound(JFeries)
If dDate = JFeries(i) Then
EstFerie = True
Exit Function
End If
Next i
End Function |
Partager