Planning Mensuel Avec l'identification des week end et des fériés

Sub Mettre_en_Forme()
Dim cell As Range
With Range("B5:AF5")
  .Interior.ColorIndex = xlNone
  .Font.FontStyle = "normal"
  .Font.ColorIndex = 1
End With
For Each cell In Range("B5:AF5")
  If TYPEJOUR(cell.Value) = 2 Then 'les jours feries
    With cell.Font
      .ColorIndex = 3
      .Bold = True
    End With
  End If
  If TYPEJOUR(cell.Value) = 1 Then 'les weeks-ends
    With cell.Font
      .ColorIndex = 43
      .Bold = True
    End With
  End If
Next cell
End Sub

'Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
'1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
'Valide jusqu'en 2099 et pour les jours fériés français
Function TYPEJOUR(D As Date)
'L. Longre
Dim A As Integer, t As Integer
Dim LP As Date, LD As Long
Dim Toto As Long
       
    A = Year(D)
    If A > 2099 Then
        TYPEJOUR = CVErr(xlErrValue)
        Exit Function
    End If
    LD = Int(D)
    If LD <= 2 Then
        If LD = 1 Then TYPEJOUR = 2
        Exit Function
    End If
    t = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
    LP = DateSerial(A, 3, 2) + t + (t > 48) _
         + 6 - ((A + A \ 4 + t + (t > 48) + 1) Mod 7)
    Select Case D
        ' Jours fériés mobiles
        Case Is = LP, Is = LP + 38, Is = LP + 49
            TYPEJOUR = 2
        ' Jours fériés fixes
        Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
            Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
            Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
            Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
                TYPEJOUR = 2
        Case Else
        ' Samedi ou dimanche
            If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
    End Select
End Function

Sub Mettre_en_Forme_Les_Vacances_scolaires()
Dim Cell As Range
For Each Cell In Range("B5:AF5")
  If EstVacanceZoneB(Cell.Value) Then 'Applique la couleur verte aux vacances zone B
    Cell.Offset(-1, 0).Interior.ColorIndex = 43 'dans la plage supérieure soit ("B4:AF4")
  End If
Next Cell
End Sub

Function EstVacanceZoneB(pdate) As Boolean
Dim Cell As Range
  With Sheets("BD")
    For Each Cell In .Range("A1").Resize(.Range("A1").End(xlDown).Row, 1)
      If pdate >= Cell.Value And pdate <= Cell.Offset(, 1) Then
        EstVacanceZoneB = True
        Exit Function
      End If
    Next Cell
  End With
  EstVacanceZoneB = False
End Function