Microsoft 365 VBA Calendrier, rien ne se passe.

Sub test_validation()
    With Range("A2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="2022,2023,2024,2025"
        .IgnoreBlank = True
        .InCellDropdown = True
    End With
End Sub

Option Explicit

Private Sub Workbook_Open()
    Dim calendarSheet As Worksheet
    ' Vérifier si la feuille "Calendrier" existe, sinon la créer
    On Error Resume Next
        Set calendarSheet = ThisWorkbook.Sheets("Calendrier")
    On Error GoTo 0
    
    If calendarSheet Is Nothing Then
        ' Créer la validation des données pour le menu déroulant de l'année
        Set calendarSheet = ThisWorkbook.Sheets.Add
        With calendarSheet
            .Name = "Calendrier"
            With .Range("A2")
                ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Name = "Cbx_An"
            End With
            [Cbx_An].Object.Font.Size = 8
            
            ' Remplir la liste des années entre 2020 et 2030 dans le menu déroulant
            Dim i As Integer
            For i = 2020 To 2030
                [Cbx_An].Object.AddItem CStr(i)
            Next i
        End With
    End If

End Sub

Private Sub Cbx_An_Change()
    Cbx_An_Has_Changed
End Sub

Sub Cbx_An_Has_Changed()
    Dim Cal_An As Integer
    Dim startDate As Date
    Dim EndDate As Date
    Dim currentRow As Long
    Dim icol As Long
    Dim icol_Odd As Long
    Dim icol_even As Long
    Dim currentDate As Date
    
    Cal_An = [Cbx_An].Object.Value
    ' Vérifier si l'année a été spécifiée
    If Cal_An <> 0 Then
        Cells.Clear
        ' Afficher les jours de la semaine en ligne 2
        With Range("B2").Resize(, 7)
            .Value = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
            .Interior.Color = vbBlack
            .Font.Color = vbWhite
        End With
        
        currentRow = 3 ' Commencer à la ligne 3
        icol_Odd = 16247773
        icol_even = 15123099
        
        ' Boucle pour afficher les dates de chaque mois
        Dim mois As Integer
        For mois = 1 To 12
            icol = IIf(mois Mod 2 = 0, icol_Odd, icol_even)
            ' Calculer la date de début et de fin pour le mois
            startDate = DateSerial(Cal_An, mois, 1)
            EndDate = DateSerial(Cal_An, mois + 1, 0)
            
            ' Afficher le nom du mois
            With Cells(currentRow, 1)
                .Value = Format(startDate, "mmmm")
                .Interior.Color = icol
            End With
            
            ' Afficher les dates du mois
            currentDate = startDate
            Do While currentDate <= EndDate
                With Cells(currentRow, Weekday(currentDate, vbMonday) + 1)
                    .Value = Format(currentDate, "dd")
                    
                    ' Colorer les jours de travail selon le cycle
                    Select Case GetWorkCycle(currentDate)
                        Case "Matin"
                            .Interior.Color = RGB(255, 0, 0) ' Rouge
                        Case "Après-midi"
                            .Interior.Color = RGB(146, 208, 80) ' Vert
                        Case "Nuit"
                            .Interior.Color = RGB(0, 176, 240) ' Bleu
                        Case "Repos"
                            .Interior.Color = RGB(192, 192, 192) ' Gris
                    End Select
                End With
                
                If Weekday(currentDate, vbMonday) = 7 Then
                    If currentDate < EndDate Then currentRow = currentRow + 1
                End If
                
                ' Passer à la prochaine date
                currentDate = currentDate + 1
            Loop
            currentRow = currentRow + 1
        Next mois
        
        ' Mettre en forme la feuille "Calendrier" pour une meilleure lisibilité
        Columns.AutoFit
        Rows.AutoFit
        Cells.HorizontalAlignment = xlCenter
        
    End If
End Sub

Function GetWorkCycle(dateValue As Date) As String
    ' Récupérer le cycle de travail en fonction de la date
    Dim startDate As Date
    Dim daysPassed As Long
    Dim cycleIndex As Integer
    Dim cycles As Variant
    
    startDate = DateSerial(2022, 12, 29) ' Date de début du cycle
    
    ' Définir les cycles de travail
    cycles = Array("Matin", "Matin", "Après-midi", "Après-midi", "Nuit", "Nuit", "Repos", "Repos", "Repos", "Repos")
    
    daysPassed = dateValue - startDate
    cycleIndex = daysPassed Mod 10
    
    GetWorkCycle = cycles(cycleIndex)
End Function

Private Sub Cbx_An_Change()
    Cbx_An_Has_Changed
End Sub

Option Explicit
Private Sub Workbook_Open()
    Dim calendarSheet As Worksheet
    ' Vérifier si la feuille "Calendrier" existe, sinon la créer
    On Error Resume Next
        Set calendarSheet = ThisWorkbook.Sheets("Calendrier")
    On Error GoTo 0
    
    If calendarSheet Is Nothing Then
        ' Créer la validation des données pour le menu déroulant de l'année
        Set calendarSheet = ThisWorkbook.Sheets.Add
        With calendarSheet
            .Name = "Calendrier"
            With .Range("A2")
                ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Name = "Cbx_An"
            End With
            [Cbx_An].Object.Font.Size = 8
            
            ' Remplir la liste des années entre 2020 et 2030 dans le menu déroulant
            Dim i As Integer
            For i = 2020 To 2030
                [Cbx_An].Object.AddItem CStr(i)
            Next i
        End With
    End If

End Sub

Private Sub Cbx_An_Change()
    Cbx_An_Has_Changed
End Sub

            With VBProject.VBComponents(.CodeName).CodeModule
                .InsertLines .CountOfLines + 1, "Private Sub Cbx_An_Change()"
                .InsertLines .CountOfLines + 1, "    Cbx_An_Has_Changed"
                .InsertLines .CountOfLines + 1, "End Sub"
            End With