XL 2016 Optimisation code agenda

[Nico_J]

Bonjour à tous,
je suis en train de créer un agenda automatique, et aimerai vos différents avis pour optimiser le code, parce que j'avoue,
ça pas top top je trouve mais ça marche.
merci

Sub Test()
    Agenda 2020, 12    'année puis mois
End Sub

Function Agenda(année, Mois)
Dim I As Long, col As Long, lig As Long, lig2 As Long, nbjour As Long
Dim derlig As Integer, dercol As Integer, j As Integer, difeuro As Long
Dim FetePren As Variant, Hdeb As Long, Hfin As Long
Application.DisplayAlerts = False: Application.ScreenUpdating = False

nbjour = Day(DateSerial(année, Mois + 1, 0))    ' te donne le nombre de jour dans le mois en parametre
If Weekday(DateSerial(année, 1, 1), vbMonday) > 4 Then difeuro = 1    ' 1 si semaine commence apres jeudi
With ActiveSheet
derlig = .Range("A" & Rows.Count).End(xlUp).Row: dercol = .Cells(2, Columns.Count).End(xlToLeft).Column

.Range(.Cells(1, 1), .Cells(derlig + 2, dercol + 2)).Clear
Hdeb = Worksheets("Paramètre").Range("C2").Value: Hfin = Worksheets("Paramètre").Range("C3").Value: lig = 2: col = 3
For I = 1 To nbjour
    .Cells(lig, col) = WorksheetFunction.Proper(Format(DateSerial(année, Mois, I), "dddd")) ' Marquage des jours (ligne 2)
    .Cells(lig, col).Font.Bold = True
    .Cells(lig, col).Font.Size = 14
    .Cells(lig + 1, col) = (Format(DateSerial(année, Mois, I), "dd" & " " & "mmmm" & " " & année))
    .Range(Cells(lig, col), Cells(lig + 1, col)).HorizontalAlignment = xlCenter
    .Cells(1, 3) = "Semaine " & " " & val(Format(DateSerial(année, Mois, 1), "WW", vbMonday)) - difeuro ' numero semaine
    .Cells(lig - 1, col) = IIf(.Cells(lig, col) Like "Lundi", "Semaine " & " " & val(Format(DateSerial(année, Mois, I), "WW", vbMonday)) - difeuro, "") ' numero semaine
    .Cells(lig - 1, col).Font.Bold = True
    .Cells(lig - 1, col).Font.Size = 18
col = col + 1
Next

derlig = .Range("A" & Rows.Count).End(xlUp).Row: dercol = .Cells(2, Columns.Count).End(xlToLeft).Column
lig = 3: lig2 = 4: col = 1:
For I = Hdeb To Hfin
    .Cells(lig, col) = Hdeb
    .Cells(lig, col).Font.Bold = True
    .Cells(lig, col).Font.Size = 16
    .Range(Cells(lig, 1), Cells(lig + 1, 1)).MergeCells = True
    .Cells(lig, 1).VerticalAlignment = xlCenter
    .Cells(lig, 1).HorizontalAlignment = xlCenter
    .Range(Cells(lig, 2), Cells(lig, dercol + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    For j = 1 To (Hfin - Hdeb)
        .Cells(lig2, 2) = 30
        .Range(Cells(lig2, 2), Cells(lig2 + 1, 2)).MergeCells = True
        .Cells(lig2, 2).VerticalAlignment = xlCenter
        .Cells(lig2, 2).HorizontalAlignment = xlCenter
        .Range(Cells(lig2, 3), Cells(lig2, dercol + 1)).Borders(xlEdgeBottom).LineStyle = xlDot
    Next
lig = lig + 2: lig2 = lig2 + 2: Hdeb = Hdeb + 1
Next

.Rows("1").RowHeight = 25
derlig = .Range("A" & Rows.Count).End(xlUp).Row: dercol = .Cells(2, Columns.Count).End(xlToLeft).Column
    .Range(Cells(4, 3), Cells(derlig, 34)).Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range("B1:AH3").Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range(Cells(1, 3), Cells(1, 33)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Columns("A").ColumnWidth = 5
    .Columns("B").ColumnWidth = 3
    .Columns("C:AG").ColumnWidth = 30
    .Rows("4:" & derlig).RowHeight = 22
 
Select Case True
   Case .Cells(1, 4) Like "*Semaine*": Range("D1:J1,K1:Q1,R1:X1,Y1:AE1,AF1:AG1").MergeCells = True
   Range("D1,K1,R1,Y1,AF1").HorizontalAlignment = xlCenter
   Case .Cells(1, 5) Like "*Semaine*": Range("C1:D1,E1:K1,L1:R1,S1:Y1,Z1:AF1").MergeCells = True
   Range("C1,E1,L1,S1,Z1").HorizontalAlignment = xlCenter
   Case .Cells(1, 6) Like "*Semaine*": Range("C1:E1,F1:L1,M1:S1,T1:Z1,AA1:AG1").MergeCells = True
   Range("C1,F1,M1,T1,AA1").HorizontalAlignment = xlCenter

    Do While Range("FichFetes!C1").Offset(x, 0) <> ""
        If Range("FichFetes!A1").Offset(x, 0) = I And Range("FichFetes!B1").Offset(x, 0) = Mois Then
            FetePren = FetePren & Range("FichFetes!C1").Offset(x, 0) & ", "
        End If
    x = x + 1
    Loop
    If FetePren <> "" Then
        .Cells(derlig + 2, col) = Chr(10) & Mid(FetePren, 1, Len(FetePren) - 2) & Chr(10) & Chr(10)
    Else
        .Cells(derlig + 2, col) = ""
    End If
     
col = col + 1
Next
End With
With ActiveWindow: .SplitColumn = 2: .SplitRow = 3: End With: ActiveWindow.FreezePanes = True
Call Actu_jour(année, Mois)
End Function

Function Actu_jour(année, Mois)


lig = 2: col = 3
With ActiveSheet
derlig = .Range("A" & Rows.Count).End(xlUp).Row
dercol = .Cells(4, Columns.Count).End(xlToLeft).Column

.Range(Cells(lig, 3), Cells(derlig + 1, dercol)).Interior.Color = xlNone
For I = 1 To nbjour
    .Range(Cells(lig, col), Cells(lig + 1, col)).Interior.ColorIndex = 34 'Coloriage jours
    .Range(Cells(lig - 1, col), Cells(lig - 1, dercol + 1)).Interior.ColorIndex = 36 'Coloriage n°semaine
If Weekday(DateSerial(année, Mois, I), vbMonday) > 6 Then .Range(Cells(lig, col), Cells(derlig, col)).Interior.ColorIndex = 34

If année = Year(Date) And Mois = Month(Date) And I = Day(Date) Then
    .Range(Cells(lig, col), Cells(lig + 1, col)).Interior.ColorIndex = 39 'Coloriage aujourd'hui
    ActiveWindow.ScrollColumn = I - 1
    .Cells(lig + 2, col).Select
End If

For j = 0 To UBound(Jférié)
    If CDate(Jférié(j) & année) = DateSerial(année, Mois, I) Then
        .Range(Cells(lig, col), Cells(derlig, col)).Interior.ColorIndex = 35 '  Interior.Color = vbGreen 'Coloriage férié
        Cells(lig, col).Interior.ColorIndex = 35 '  Interior.Color = vbGreen 'Coloriage férié
        Cells(lig + 2, col) = Jfériéstring(j)
        Cells(lig + 2, col).HorizontalAlignment = xlCenter
    End If
Next
   
For k = 0 To UBound(Jfete)
    If CDate(Jfete(k) & année) = DateSerial(année, Mois, I) Then
        .Range(Cells(lig, col), Cells(lig + 1, col)).Interior.ColorIndex = 35 '  Interior.Color = vbGreen 'Coloriage férié
        Cells(lig, col).Interior.ColorIndex = 35 '  Interior.Color = vbGreen 'Coloriage fête
        Cells(lig + 2, col) = Jfetestring(k)
        Cells(lig + 2, col).HorizontalAlignment = xlCenter
    End If
Next
    .Cells(derlig + 1, col) = "Fêtes à souhaiter" & " :  "
    .Cells(derlig + 1, col).Interior.ColorIndex = 36
    .Cells(derlig + 2, col).Interior.ColorIndex = 34
    .Cells(derlig + 1, col).Font.Bold = True
    .Cells(derlig + 1, col).Font.Size = 11
    .Rows(derlig + 1).RowHeight = 15
    .Rows(derlig + 2).RowHeight = 60
col = col + 1
Next
End With
End Function