Function create_calendrier(année As Long, Mois As Long)
Dim i As Long, col As Long, lig As Long, nbjour As Long
Dim j As Long, Jférié() As Variant, Jfériéstring() As Variant
Dim vdate As Date
Dim zoneA As Range, zoneB As Range, zoneC As Range
Dim cell As Range
Dim paques As Date, ascension As Date, pentecote As Date, lunpentecote As Date
Application.ScreenUpdating = False
' Calcul des fêtes mobiles
paques = CDate(((Round(DateSerial(année, 4, (234 - 11 * (année Mod 19)) Mod 30) / 7, 0) * 7) - 6))
ascension = paques + 39
pentecote = paques + 49
lunpentecote = paques + 50
' Liste des jours fériés
Jférié = Array( _
DateSerial(année, 1, 1), _
DateSerial(année, 5, 1), _
DateSerial(année, 5, 8), _
ascension, _
pentecote, _
lunpentecote, _
DateSerial(année, 7, 14), _
DateSerial(année, 8, 15), _
DateSerial(année, 11, 1), _
DateSerial(année, 11, 11), _
DateSerial(année, 12, 25) _
)
Jfériéstring = Array( _
"Jour de l'an", "Fête du Travail", "Victoire 1945", _
"Ascension", "Pentecôte", "Lundi de Pentecôte", _
"Fête Nationale", "Assomption", "Toussaint", "Armistice", "Noël" _
)
' Nombre de jours dans le mois
nbjour = Day(DateSerial(année, Mois + 1, 0))
col = Weekday(DateSerial(année, Mois, 1), vbMonday) + 1 ' Lundi = 2 dans le tableau
' Ligne de départ pour le calendrier
lig = Range("Calendrier").row + 1
' Définir les plages pour les zones A, B et C
With Worksheets("Vacances")
Set zoneA = .Range("A2:A" & .cells(.rows.Count, "A").End(xlUp).row)
Set zoneB = .Range("B2:B" & .cells(.rows.Count, "B").End(xlUp).row)
Set zoneC = .Range("C2:C" & .cells(.rows.Count, "C").End(xlUp).row)
End With
' Génération du calendrier
With Worksheets("Calendrier")
' Effacer le contenu précédent
.Range("Calendrier").ClearContents
.Range("Calendrier").Offset(1, 1).Interior.Color = xlNone
.Range("Calendrier").Offset(1, 1).ClearComments
' Effacer les cellules hors du tableau principal
.Range("B17:B18").ClearContents
.Range("B20").ClearContents
.Range("D17:E17").ClearContents
.Range("G17").ClearContents
' Boucle pour générer les jours du mois
For i = 1 To nbjour
If col = 9 Then lig = lig + 5: col = 2
.cells(lig, col).Interior.Color = 15395562 ' Couleur par défaut pour les jours
.cells(lig, col).Value = i
' Calcul de la date actuelle
vdate = DateSerial(année, Mois, i)
' Vérification des zones (A, B, C) et application de couleurs
For Each cell In zoneA
If cell.Value = vdate Then
.cells(lig + 1, col).Interior.Color = RGB(255, 0, 0) ' Rouge clair pour zone A
Exit For
End If
Next cell
For Each cell In zoneB
If cell.Value = vdate Then
.cells(lig + 2, col).Interior.Color = RGB(146, 208, 80) ' Vert clair pour zone B
Exit For
End If
Next cell
For Each cell In zoneC
If cell.Value = vdate Then
.cells(lig + 3, col).Interior.Color = RGB(0, 176, 240) ' Bleu clair pour zone C
Exit For
End If
Next cell
' Vérification des jours fériés
For j = LBound(Jférié) To UBound(Jférié)
If vdate = Jférié(j) Then
.cells(lig + 4, col).Interior.Color = 10092441 ' Couleur pour jour férié
.cells(lig + 4, col).Value = Jfériéstring(j)
End If
Next j
' Coloration du jour actuel
If Date = vdate Then
.cells(lig, col).Interior.Color = RGB(0, 255, 0) ' Vert pour le jour actuel
End If
col = col + 1
Next i
' Ajout du titre et des jours de la semaine
.Range("B1").Value = UCase(Format(DateSerial(année, Mois, 1), "mmmm yyyy"))
.Range("A2").Resize(1, 8).Value = Array("Semaine", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
End With
Algorithme année, Mois, 12
Call recup_phase
Application.ScreenUpdating = True
End Function
