Private Sub ComboBox1_GotFocus()
ComboBox1.List = Array(2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, _
2020, 2021, 2022, 2023, 2024, 2025, 2026, 2027, 2028, 2029, 2030)
ComboBox1.Width = [A1].Width
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex > -1 Then [A1] = Val(ComboBox1)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim an As Range, ncol%, r As Range, deb%, i%, ferie As Range
Set an = [A1]
If Intersect(Target, an) Is Nothing Then Exit Sub
If Val(CStr(an)) < 2010 Then an = Year(Date)
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'pour la fusion des cellules
With [B6:ABE58] '58 à adapter au nombre de noms
ncol = .Columns.Count
'---RAZ des bordures---
Set r = .Columns(2)
For i = 4 To ncol Step 2
Set r = Union(r, .Columns(i))
Next
r.Borders(xlEdgeRight).Weight = xlHairline
'---semaines, création et bordures fines---
.Rows(-2).UnMerge 'défusionne
.Rows(-2) = "=""SEM ""&WEEKNUM(R[2]C,2)"
.Rows(-2) = .Rows(-2).Value
deb = 1
For i = 2 To ncol + 1
If .Cells(-2, i) <> .Cells(-2, i - 1) Then
Set r = .Cells(-2, deb).Resize(, i - deb)
r.Merge 'fusionne
r.HorizontalAlignment = xlCenter
If i < ncol + 1 Then r.Borders(xlEdgeRight).Weight = xlThin
With Intersect(r.EntireColumn, .Cells)
.Borders(xlEdgeRight).Weight = xlThin
End With
deb = i
End If
Next
'---bordures épaisse des mois---
For Each r In .Rows(-4).SpecialCells(xlCellTypeConstants)
Intersect(r.MergeArea.EntireColumn, .Cells).Borders(xlEdgeRight).Weight = xlThick
Next
'---effacement des couleurs---
.Interior.ColorIndex = xlNone
'---coloration des week-ends---
Set r = Nothing
For i = 1 To ncol
If Weekday(.Cells(0, i), 2) > 5 Then _
Set r = Union(IIf(r Is Nothing, .Columns(i), r), .Columns(i))
Next
r.Interior.ColorIndex = 15 'gris
'---coloration des jours fériés---
Set ferie = [Feries].Columns(an - 2008)
Set r = Nothing
For i = 1 To ncol
If Application.CountIf(ferie, .Cells(0, i)) Then _
Set r = Union(IIf(r Is Nothing, .Columns(i), r), .Columns(i))
Next
r.Interior.ColorIndex = 38 'rose
'---affichage/masquage du 29 février---
.Columns(119).Resize(, 2).ColumnWidth = IIf(IsDate("29/2/" & an), 1, 0.1)
'---Cadrage---
i = IIf(Year(Date) = an, Application.Match(Format(Date, "mmmm"), .Rows(-4), 0), 1)
Application.Goto .Cells(-4, i), True
.Cells(-1, i).Select
End With
End Sub