1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
| Sub CalendrierJoursOuvrés()
Dim ok As Boolean, ko As Boolean
Dim i As Integer, j As Integer, L As Integer, DateRef As Date
JoursFériés = Array("28 mars 2005", "5 mai 2005", "14 juillet 2005", "15 août 2005", "1 novembre 2005", "11 novembre 2005")
NomFeuille = Format(DateSerial(2005, 1, 1), "mmmm") 'Feuille janvier
ActiveSheet.Name = NomFeuille
j = 1
For i = 1 To 365
DateRef = DateSerial(2005, 1, i)
If Format(DateRef, "dd") = "01" And i > 31 Then
L = 1
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 'MoisPrécédent
NomFeuille = Format(DateRef, "mmmm")
ActiveWorkbook.ActiveSheet.Name = NomFeuille
End If
ko = False
For k = 1 To UBound(JoursFériés)
ko = ko Or InStr(Format(CDate(DateRef), "dd mmmm yyyy"), JoursFériés(k)) <> 0
If ko Then Exit For
Next k
ok = Format(WeekDay(DateRef), "dddd") <> "samedi"
ok = ok And Format(WeekDay(DateRef), "dddd") <> "dimanche"
If ok And Not ko Then
L = L + 1
Worksheets(NomFeuille).Cells(L, 1).Formula = Format(DateRef, "dddd dd mmmm yyyy")
j = j + 1
End If
Next
End Sub |
Partager