Sub test_I_Ca()
'Sur un an uniquement lundi mercredi ou jeudi.
Cells.Clear
Application.ScreenUpdating = False
CalendrierSpecial 2, 4, 5, 2, "ddd-d"
End Sub
Sub test_II_Lb()
'Idem mais que avec lundi mercredi samedi.
Cells.Clear
Application.ScreenUpdating = False
CalendrierSpecial 2, 4, 7, 1, "ddd dd mmmm yyyy"
End Sub
Private Sub CalendrierSpecial(J1, J2, J3, Sens As XlRowCol, dFormat As String)
Dim x, l&, p As Range, z As Range
annee = InputBox("Année?", "Calendrier", Year(Date)): x = DateValue("31/12/" & annee): [A1] = DateValue("1/1/" & annee): l = DatePart("y", x)
Set p = Range(Cells(1, 1), Choose(Sens, Cells(1, l), Cells(l, 1))): p.DataSeries Sens, 3, 1, 1, CLng(x), False
p.Offset(Choose(Sens, 1, 0), Choose(Sens, 0, 1)).Formula = "=MATCH(WEEKDAY(A1),{" & J1 & ";" & J2 & ";" & J3 & "},0)"
Set z = Range("A1").CurrentRegion.SpecialCells(xlCellTypeFormulas, 16)
Select Case Sens
Case 1: z.EntireColumn.Delete: Rows(2).Delete
Case 2: z.EntireRow.Delete: Columns("B:B").Clear
End Select
Range("A1").CurrentRegion.NumberFormat = dFormat
End Sub