Option Explicit
Sub Création_Calendrier()
Dim Début, Fin As Date
Dim i As Date
Dim Cell As Range, li&
Dim C As Range
Dim dl&
Début = Sheets("PLANNING").Range("B2").Value
Fin = Sheets("PLANNING").Range("B3").Value
Set Cell = Sheets("PLANNING").Range("A5")
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
li = Cell.Row
For i = Début To Fin
Cells(li, 1).Select
With Selection
.Value = i
.NumberFormatLocal = "jjjj jj mmmm aaaaa"
.HorizontalAlignment = xlLeft
.InsertIndent 1
' .Borders.Weight = xlThin
.Font.Bold = True
End With
li = li + 12
Next i
With ActiveSheet
dl = .Cells(.Rows.Count, "A").End(xlUp).Row + 11
End With
For Each C In Range("A5:A" & dl)
If C.Value = "" Then
C.FormulaR1C1 = "=R[-1]C"
C.Value = C.Value
C.Font.Bold = True
C.HorizontalAlignment = xlLeft
C.InsertIndent 1
End If
Next C
Etape1
For Each C In Range("A5:A" & dl)
'Select Case Weekday(DateSerial(An, mois, C), vbMonday)
Select Case Weekday(C, vbMonday)
Case 1, 3, 5 'Lundi, Mercredi, Vendredi
C.Resize(, 2).Interior.ColorIndex = 44
Case 2, 4 'mardi, jeudi
C.Resize(, 2).Interior.ColorIndex = 6
Case 6 'Samedi
C.Resize(, 2).Interior.ColorIndex = 20
Case 7 'Dimanche
C.Resize(, 2).Interior.ColorIndex = 37
End Select
Next C
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub efface()
Dim dl&
With ActiveSheet
dl = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Range("A5:B" & dl)
.ClearContents 'Efface
.Interior.Pattern = xlNone
.HorizontalAlignment = xlLeft
.IndentLevel = 0
End With
End Sub
Sub Etape1()
Dim Vals, dl&
Vals = Array("ADD", "GFT", "FRE", "HJK", "FGT", "RET", "LMP", "JJU", "TYU", "FGR", "AZE ", "EZS")
[B5:B16] = Application.Transpose(Vals)
With ActiveSheet
dl = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B5:B16").AutoFill Destination:=.Range("B5:B" & dl), Type:=xlFillCopy
.Range("B5:B" & dl).Font.Bold = True
End With
End Sub