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
| Sub planning()
' Oter la protection de la feuille pour prévenir toute erreur.
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
' Inhiber le scintillement de la feuille pendant la création du calendrier.
Application.ScreenUpdating = False
' Set up error trapping.
On Error GoTo MyErrorTrap
' Vider la zone a1:g14 y compris tout calendrier précédent.
Range("a1:g14").Clear
' Utilisez InputBox pour obtenir mois et l'année désirée et variable fixé
' MyInput.
MyInput = InputBox("Tapez le mois et l'année du calendrier")
' Permettre à l'utilisateur de mettre fin macro avec Annuler dans InputBox.
If MyInput = "" Then Exit Sub
' Obtenir la valeur de date du début du mois entrées.
StartDay = DateValue(MyInput)
' Vérifiez si la date valide, mais pas le premier du mois.
' -- si oui, réinitialiser StartDay au premier jour du mois.
If Day(StartDay) <> 1 Then
StartDay = DateValue(Month(StartDay) & "/1/" & _
Year(StartDay))
End If
' Préparer la cellule pour le mois et année en toutes lettres.
Range("a1").NumberFormat = "mmmm yyyy"
' Centrer l'étiquette Mois et Année dans a1: g1 avec formatage
' la taille, la hauteur et la mise en gras.
With Range("a1:g1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With
' Preparer le formatage des cellules a2:g2 des jours de la semaine.
' Centrage, taille, hauteur et mise en gras.
With Range("a2:g2")
.ColumnWidth = 11
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
' Mettez les jours de la semaine dans a2:g2.
Range("a2") = "Dimanche"
Range("b2") = "Lundi"
Range("c2") = "Mardi"
Range("d2") = "Mercredi"
Range("e2") = "Jeudi"
Range("f2") = "Vendredi"
Range("g2") = "Samedi"
' Preparer les cellules dates a3:g3 avec alignement gauche et haut, tailles et hauteur.
' et mise en gras.
With Range("a3:g8")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
' Mettre le mois et l'année tapés en entrée dans "a1".
Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
' Definir la variable et obtenir le début du jour de la semaine du mois.
DayofWeek = Weekday(StartDay)
' Définir des variables afin d'identifier l'année et le mois en tant
' que variables distinctes.
CurYear = Year(StartDay)
CurMonth = Month(StartDay)
' Definir la variable et calculer le premier jour du mois suivant.
FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
' Placer un "1" dans la cellule position du premier jour du mois sélectionné
' sur la base de DayofWeek.
Select Case DayofWeek
Case 1
Range("a3").Value = 1
Case 2
Range("b3").Value = 1
Case 3
Range("c3").Value = 1
Case 4
Range("d3").Value = 1
Case 5
Range("e3").Value = 1
Case 6
Range("f3").Value = 1
Case 7
Range("g3").Value = 1
End Select
' Bouclage et incrémentation de chaque cellule après celle de "1" suivant la
' plage a3:g8.
For Each cell In Range("a3:g8")
RowCell = cell.Row
ColCell = cell.Column
' Faire si "1" est dans la première colonne.
If cell.Column = 1 And cell.Row = 3 Then
' Faire si cellule courante n'est pas en 1ère colonne.
ElseIf cell.Column <> 1 Then
If cell.Offset(0, -1).Value >= 1 Then
cell.Value = cell.Offset(0, -1).Value + 1
' Arrêt lorsque le dernier jour du mois a été
' entré.
If cell.Value > (FinalDay - StartDay) Then
cell.Value = ""
' Sortie de la boucle quand le calendrier possède le bon nombre de
' jours indiqués.
Exit For
End If
End If
' Faire seulement si la cellule actuelle ne est pas à la ligne 3 et à la colonne 1.
ElseIf cell.Row > 3 And cell.Column = 1 Then
cell.Value = cell.Offset(-1, 6).Value + 1
' Arrêt lorsque le dernier jour du mois a été saisi.
If cell.Value > (FinalDay - StartDay) Then
cell.Value = ""
' Sortie de la boucle lorsque le calendrier a le bon nombre de
' jours indiqués.
Exit For
End If
End If
Next
' Formatage et mise en forme des cellules d'entrées JOUR
For x = 0 To 5
Range("A4").Offset(x * 2, 0).EntireRow.Insert
With Range("A4:G4").Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.Font.Bold = False
' Déverrouiller ces cellules pour être en mesure de saisir du texte plus tard.
.Locked = False
End With
' Formatage bordure autour du bloc de dates.
With Range("A3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Range("A3").Offset(x * 2, 0).Resize(2, _
7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
.Resize(2, 8).EntireRow.Delete
' Inhiber le quadrillage.
ActiveWindow.DisplayGridlines = False
' Protéger la feuille pour éviter d'écraser les dates.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
' Redimensionner la fenêtre pour montrer tout le calendrier (peut-être ajusté pour
' configuration video).
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1
' Allow screen to redraw with calendar showing.
Application.ScreenUpdating = True
' Prevent going to error trap unless error found by exiting Sub
' here.
Exit Sub
' Erreur ouvre une fenêtre pour signaler le problème, fournit une nouvelle zone de saisie
' et reprend à la ligne ce qui a provoqué l'erreur.
MyErrorTrap:
MsgBox "Vous n'avez pas entré le Mois ou Année correctement." _
& Chr(13) & "Epelez correctement le mois" _
& " (ou utiliser une abréviation de 3 lettres)" _
& Chr(13) & "et 4 chiffres pour l'année"
MyInput = InputBox("Tapez le mois et l'année du Calendrier")
If MyInput = "" Then Exit Sub
Resume
End Sub |
Répondre avec citation
Partager