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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
| Private Sub Bouton_Français2_Click()
'Masquage du formulaire
Choix_Langue.Hide
'Réinitialisation
Cells.Value = Empty
Cells.Borders.LineStyle = xlNone
Cells.Font.ColorIndex = xlAutomatic
Cells.Font.Bold = False
Cells.VerticalAlignment = xlCenter
Cells.MergeCells = False
ActiveWindow.DisplayGridlines = True
Cells.Interior.ColorIndex = xlColorIndexNone 'rajout
'Liste personnelle
Application.AddCustomList ListArray:=Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
'Mise en forme
'Range("A1:AJ1").HorizontalAlignment = xlCenterAcrossSelection
Range("A1").HorizontalAlignment = xlCenterAcrossSelection
Cells.Font.Size = 11
'Année
Dim Message, Titre, Année, Défaut
Message = "Entrez l'année"
Titre = "Année du calendrier"
Défaut = Year(Now)
Année = InputBox(Message, Titre, Défaut)
'En-tête
ActiveSheet.Name = Année
'Mois
Range("A1").Value = "Janvier"
Range("A33").Value = "Février"
Range("A65").Value = "Mars"
Range("A97").Value = "Avril"
Range("A129").Value = "Mai"
Range("A161").Value = "Juin"
Range("A193").Value = "Juillet"
Range("A225").Value = "Août"
Range("A257").Value = "Septembre"
Range("A289").Value = "Octobre"
Range("A321").Value = "Novembre"
Range("A353").Value = "Décembre"
'Dates
'Mois en 31 jours
For a = 1 To 31
Range("B" & a + 1).Value = a
'mars
Range("B" & a + 65).Value = a
'mai
Range("B" & a + 129).Value = a
'juillet
Range("B" & a + 193).Value = a
'aout
Range("B" & a + 225).Value = a
'octobre
Range("B" & a + 289).Value = a
'decembre
Range("B" & a + 353).Value = a
Next a
'Mois en 30 jours
For a = 1 To 30
'avril
Range("B" & a + 97).Value = a
'juin
Range("B" & a + 161).Value = a
'septembre
Range("B" & a + 257).Value = a
'novembre
Range("B" & a + 321).Value = a
Next a
'Février
For a = 1 To 28
Range("B" & a + 33).Value = a
Next a
On Error Resume Next
Weekday ("29/02/" & Année)
If Err.Number = 13 Then Err.Clear: Range("B62").Value = Empty Else Range("B62").Value = 29
'Jours
'Janvier
Jour = Weekday("01/01/" & Année)
If Jour = 2 Then Journée = "Lundi"
If Jour = 3 Then Journée = "Mardi"
If Jour = 4 Then Journée = "Mercredi"
If Jour = 5 Then Journée = "Jeudi"
If Jour = 6 Then Journée = "Vendredi"
If Jour = 7 Then Journée = "Samedi"
If Jour = 1 Then Journée = "Dimanche"
Range("A2").Value = Journée
Range("A2").AutoFill Destination:=Range("A2:A32")
'Février
Range("A34").Value = Range("A26").Value
If Range("A62").Value = Empty Then Range("A34").AutoFill Destination:=Range("A34:A61") Else Range("A34").AutoFill Destination:=Range("A34:A62")
'Mars
If Range("B62").Value = Empty Then Range("A66").Value = Range("A55").Value Else Range("A66").Value = Range("A55").Value
Range("A66").AutoFill Destination:=Range("A66:A96")
'Avril
Range("A98").Value = Range("A58").Value
Range("A98").AutoFill Destination:=Range("A98:A127")
'Mai
Range("A130").Value = Range("A121").Value
Range("A130").AutoFill Destination:=Range("A130:A160")
'Juin
Range("A162").Value = Range("A154").Value
Range("A162").AutoFill Destination:=Range("A162:A191")
'Juillet
Range("A194").Value = Range("A185").Value
Range("A194").AutoFill Destination:=Range("A194:A224")
'Août
Range("A226").Value = Range("A218").Value
Range("A226").AutoFill Destination:=Range("A226:A256")
'Septembre
Range("A258").Value = Range("A250").Value
Range("A258").AutoFill Destination:=Range("A258:A287")
'Octobre
Range("A290").Value = Range("A281").Value
Range("A290").AutoFill Destination:=Range("A290:A320")
'Novembre
Range("A322").Value = Range("A314").Value
Range("A322").AutoFill Destination:=Range("A322:A351")
'Décembre
Range("A354").Value = Range("A345").Value
Range("A354").AutoFill Destination:=Range("A354:A384")
'Semaines
b = 1
For Mois = 1 To 36 Step 3
For a = 2 To 384
If Cells(a, Mois).Value = "Lundi" Then Cells(a, Mois + 2).Value = b: b = b + 1
Next a
Next Mois
'Mise en page
'Grille
ActiveWindow.DisplayGridlines = False
With Range("A1:B384").Borders
.LineStyle = xlContinuous
.ColorIndex = 1 ''''''''''''''''''''''''''''''''''''''''' couleur total grille
End With
ActiveWindow.DisplayGridlines = False
With Range("D1:AZ384").Borders
.LineStyle = xlContinuous
.ColorIndex = 1 ''''''''''''''''''''''''''''''''''''''''' couleur total grille
End With
Range("A1:AZ384").Borders(xlEdgeLeft).Weight = xlThick ''''' barre
Range("A1:AZ384").Borders(xlEdgeTop).Weight = xlThick ''' barre
Range("A1:AZ384").Borders(xlEdgeBottom).Weight = xlThick ''' barre
Range("A1:AZ384").Borders(xlEdgeRight).Weight = xlThick '''' barre
Range("A1:AZ384").Borders(xlEdgeLeft).ColorIndex = 5 ''''''''barre de gauche
Range("A1:AZ384").Borders(xlEdgeTop).ColorIndex = 5 '''''''''barre du haut
Range("A1:AZ384").Borders(xlEdgeBottom).ColorIndex = 5 ''''''barre du bas
Range("A1:AZ384").Borders(xlEdgeRight).ColorIndex = 5 ''''''barre de droite
Range("A1:AZ384").Font.Bold = True
'Semaines
b = 1
For Mois = 1 To 36 Step 3
For a = 2 To 384
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Cells(a, Mois).Value = "Lundi" Then Cells(a, Mois + 2).Value = b: b = b + 1
If Cells(a, Mois).Value = "Lundi" Then If a = 2 Then GoTo FinDeBoucle Else Range(Cells(a, Mois), Cells(a, Mois + 51)).Borders(xlEdgeTop).Weight = xlMedium: Range(Cells(a, Mois), Cells(a, Mois + 51)).Borders(xlEdgeTop).ColorIndex = 5 '''couleur bas cellulle dimanche
If Cells(a, Mois).Value = "Dimanche" Then Cells(a, Mois).Font.ColorIndex = 5 '''couleur du dimanche
If Cells(a, Mois).Value = "Dimanche" Then Cells(a, Mois + 1).Font.ColorIndex = 5 '''chiffre du dimanche
If Cells(a, Mois).Value = "Lundi" Then If a = 4 Then Range(Cells(a - 2, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois).Value = "Lundi" Then If a = 5 Then Range(Cells(a - 3, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois).Value = "Lundi" Then If a = 6 Then Range(Cells(a - 4, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois).Value = "Lundi" Then If a = 7 Then Range(Cells(a - 5, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois).Value = "Lundi" Then If a = 8 Then Range(Cells(a - 6, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois).Value = "Lundi" Then If a = 9 Then Range(Cells(a - 7, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois + 2).Value = Empty Then GoTo FinDeBoucle
If Cells(a, Mois + 2).Row <= 26 Then Range(Cells(a, Mois + 2), Cells(a + 6, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois + 2).Row = 27 Then Range(Cells(a, Mois + 2), Cells(a + 5, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois + 2).Row = 28 Then Range(Cells(a, Mois + 2), Cells(a + 4, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois + 2).Row = 29 Then Range(Cells(a, Mois + 2), Cells(a + 3, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois + 2).Row = 30 Then Range(Cells(a, Mois + 2), Cells(a + 2, Mois + 2)).Cells.MergeCells = True
If Cells(a, Mois + 2).Row = 31 Then Range(Cells(a, Mois + 2), Cells(a + 1, Mois + 2)).Cells.MergeCells = True
FinDeBoucle: Next a
Next Mois
Range("C:C,C:C,I:I,L:L,O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ").Font.Bold = True
'Fermeture du formulaire
Unload Choix_Langue
End Sub |
Suite de date automatique
Répondre avec citation
Partager