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
30
31
32
33
34
35
36
| Sub JO()
Dim ok As Boolean, jf As Boolean, JoursFériés As Variant, k As Byte
Dim i As Integer, j As Integer, NoLigne As Integer, dateref As Date
Application.DisplayAlerts = False
'Suppression de toutes les feuilles du classeur sauf une
ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
For i = ActiveWorkbook.Worksheets.Count - 1 To 1 Step -1
Worksheets(i).Delete
Next
JoursFériés = Array("", "1 janvier 2007", "28 mars 2007", "1 mai 2007", "8 mai 2007", "17 mai 2007", "28 mai 2007", "14 juillet 2007", "15 août 2007", "1 novembre 2007", "11 novembre 2007", "25 décembre 2007")
'On nomme la feuille qui reste (janvier)
ActiveSheet.Name = Format(DateSerial(2007, 1, 1), "mmmm")
NoLigne = 2
For i = 1 To 365
dateref = DateSerial(2007, 1, i)
'Création de la feuille du mois
'La feuille de janvier existe, on l'exclut : C'est le 1er du mois, mois > janvier
If Format(dateref, "dd") = "01" And Month(dateref) > 1 Then
NoLigne = 2
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveWorkbook.ActiveSheet.Name = Format(dateref, "mmmm")
End If
jf = False 'Exclusion des jours fériés
For k = 1 To UBound(JoursFériés)
jf = jf Or InStr(Format(CDate(dateref), "dd mmmm yyyy"), JoursFériés(k)) <> 0
If jf Then Exit For 'C'est un jour férié
Next k
If Format(Weekday(dateref), "dddd") <> "samedi" And _
Format(Weekday(dateref), "dddd") <> "dimanche" And _
Not jf Then
ActiveSheet.Cells(NoLigne, 1).Formula = UCase(Left(Format(dateref, "dddd"), 1))
ActiveSheet.Cells(NoLigne, 2).Formula = Format(dateref, "dd")
NoLigne = NoLigne + 1
End If
Next
End Sub |
