Générer un planning avec dates et jours

Version imprimable

bonjour

je voudrais à partir d'un formulaire en choississant le mois ou la période, afficher un état "planning" pour indiquer les tâches effectuées sur la période par personne

Savez vous comment déterminer le premier jour et le dernier jour, indiquer les noms des jours (L,M,M,J,V), affecter des couleurs aux samedis et dimanches, et indiquer les jours fériés

voici un début de code qui est sensé recherche le 1er et dernier jour du mois mais qui ne fonctionne pas non plus :(
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Private Sub EntêtePage0_Print(Cancel As Integer, PrintCount As Integer) Dim J DateDébutMois = DateSerial(Year(2010), Month(1), 1) DateFinMois = DateSerial(Year(2010), Month(1) + 1, 0) 'DateFinMois = DateAdd("m", 1, DateDébutMois) NbJoursMois = DateFinMois - DateDébutMois For J = 1 To NbJoursMois Me.CurrentX = ((J - 1) * interv) + MargeGauche Me.CurrentY = 13 Me.FontSize = 8 Me.FontName = "Arial" Me.Print J Next J End Sub
Merci

J'ai un peu progressé sur ce code et lorsque je rentre ces données 2010 3 1

il m'indique que la datedébutMois est le 01/01/1905 , Pourquoi ?:roll:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim J
   DateDébutMois = DateSerial(Year(2010), Month(3), 1)
   DateFinMois = DateAdd("m", 1, DateDébutMois)
 
   NbJoursMois = DateFinMois - DateDébutMois
   For J = 1 To NbJoursMois
       Me.CurrentX = ((J - 1) * interv) + MargeGauche
       Me.CurrentY = 13
       Me.FontSize = 8
       Me.FontName = "Arial"
       Me.Print J
       Debug.Print J
   Next J
End Sub

14/01/2010, 11h43
Jean-Philippe André

salut,
parce que tu ne précises pas les bonnes valeurs en paramètres :oops:
les valeurs attendues sont

Code:

DateSerial(annee, mois, jour)

c'est à dire

Code:

DateSerial(2010, 3, 1)

or ici en passant les paramètres

Code:

DateSerial(Year(2010), Month(3), 1)

tu demande l'année du 2010e jour depuis le 01/01/1900,
le mois du 3e jour depuis le 01/01/1900,
et le 1 reste 1 :aie:

Bonjour

merci beaucoup pour ta réponse

effectivement ca fonctionne beaucoup mieux !

Voici le code qui fonctionne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 'Numéro des jours 'Numéro des jours Dim j DateDébutMois = DateSerial(2010, Forms![F_InterventionChef]!ChoixMois, 1) DateFinMois = DateAdd("m", 1, DateDébutMois) NbJoursMois = DateFinMois - DateDébutMois For j = 1 To NbJoursMois Me.CurrentX = ((j - 1) * interv) + MargeGauche Me.CurrentY = 13 Me.FontSize = 8 Me.FontName = "Arial" Me.Print j Next j end sub
Pour parfaire ce planning, je voudrais qu'il m'affiche maintenant en dessous le nom des jours (L, M, M, J, V, S, D)

puis je me servir du même code, avec un format particulier par exemple ?

Merci

Bonjour,

Vous pouvez vous servir d'une variable DateJ incrémentée à chaque passage de boucle pour tous les jours du mois:
Et utiliser la fonction format pour afficher le jour de la semaine:

Ainsi votre code pourrait ressembler à cela:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Dim j Dim DateJ As Date ... ... DateDébutMois = DateSerial(2010, 1, 1) DateJ = DateDébutMois DateFinMois = DateAdd("m", 1, DateDébutMois) NbJoursMois = DateFinMois - DateDébutMois For j = 1 To NbJoursMois Me.CurrentX = ((j - 1) * interv) + MargeGauche Me.CurrentY = 13 Me.FontSize = 8 Me.FontName = "Arial" Me.Print j & vbNewLine & UCase(Left(Format(DateJ, "ddd"), 1)) DateJ = DateJ + 1 Next j
Bonne continuation...

20/01/2010, 19h56
isabelle b

Bonsoir et merci pour vos réponses

J'ai essayé le code de user avec dateJ Mais il affiche deux lignes avec les numéros des jours et non pas les initiales malgré format

j'ai essayé plusieurs différentes configuration du format, mais aucun résultat
21/01/2010, 20h36
User

Bjr,

Pas évident sans le code complet,:?

Peut-être que l'instruction s'exécute 2 fois.

Remarque : Pourquoi ne pas utiliser des étiquettes pour les en-têtes de colonnes. Après pour le planning vous dimensionnez des étiquettes dans la section détail sur l'évènement format.

Les étiquettes (labels): peuvent être dimensionnées sur 1 jour, 2 jour etc..
les dimensions définies sur l'évènement format sont conservées sur chaque ligne, tout comme la couleur de fond et le texte.

(les 31 étiquettes de la section détail doivent seulement être crées dans l'ordre inverse pour que les premières se superposent aux suivantes)

Comme çà pas besoin de définir les positions du texte ou autre, et cela allège donc le code...

bonjour

eh bien pour cette partie le code me semblait complet en fait.

Ton idée de juste changer le format était très bonne. Il imprime bien sur deux lignes, il faut juste lui dire que la ligne du dessous doit imprimer les initiales des jours et non leur numéro

pour le moment j'ai créé, le code suivant qui répond à la demande, mais je trouvais que celui que tu m'avais proposé était plus simple

Code:

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
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
Option Compare Database         'Utilise l'ordre de la base pour les comparaisons de chaînes
Option Explicit
Const MargeGauche = 4000
Const interv = 350
Const hauteur = 325
Dim DateFinMois, DateDébutMois, NbJoursMois
Private Sub Détail1_Format(Cancel As Integer, FormatCount As Integer)
  On Error Resume Next
   Dim TexteAffiché As String, largeur, sql, couleur_fond, couleurChef
   Dim jd, jf, gtexte, gauche, Début, Fin, j
   Dim bd As Database
   Dim dt1 As Recordset
   Dim dt2 As Recordset
   Set bd = CurrentDb()
    sql = "SELECT * FROM re_Intervention"
     sql = sql + " WHERE Cle='" & Me.Cle & "'"
 
 
   Set dt2 = bd.OpenRecordset(sql)
 
               'coloriage des samedis et dimanches couleur de fond gris
   For j = 1 To NbJoursMois - 1
       If Weekday(DateDébutMois + j) = vbSaturday Or Weekday(DateDébutMois + j) = vbSunday Then
         Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 12632256, BF
         Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B
 
       Else
        Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B
       End If
   Next j
 
 
'calcul des intervalles de dates - ne fonctionne pas si la date_début et la date_fin est le 1er du mois (ne rentre pas dans la boucle)
   Do While Not dt2.EOF
     If Not (dt2!Date_Fin <= DateDébutMois Or dt2!Date_Début >= DateFinMois) Then
       If dt2!Date_Début < DateDébutMois Then Début = DateDébutMois Else Début = dt2!Date_Début
       If dt2!Date_Fin >= DateFinMois Then Fin = DateFinMois Else Fin = dt2!Date_Fin
 
      jd = Début - DateDébutMois
      jf = Fin - DateDébutMois
      TexteAffiché = dt2!NomChef
      couleur_fond = dt2!couleurChef 'pour les intervalles
 
'Cadre de la marge de gauche ou 1er cadre
       Me.Line (MargeGauche, 1)-(MargeGauche + (interv * NbJoursMois - 1), hauteur), 0, B
 
 'Traçages intervalles
       gauche = (jd * interv) + MargeGauche
       largeur = (jf - jd + 1) * interv
       Me.Line (gauche, 1)-(gauche + largeur, hauteur), couleur_fond, BF     ' coloriage jours intervalles tâches
       Me.Line (gauche, 1)-(gauche + largeur, hauteur), 0, B                  ' encadré noir des jours intervalles tâches
 
    'placement des tâches en couleur
       Me.CurrentX = gauche + 200
       Me.CurrentY = 70
       Me.FontSize = 6
       Me.FontName = "Verdana"
       Me.Print TexteAffiché
     End If
 
 
    dt2.MoveNext
 
   Loop
   dt2.Close
End Sub
 
 
Private Sub EntêteGroupe2_Format(Cancel As Integer, FormatCount As Integer)
 Dim j
 
'Cadre de la marge de gauche ou 1er cadre
       Me.Line (MargeGauche, 1)-(MargeGauche + (interv * NbJoursMois - 1), hauteur), 0, B
 
' Lettre de cette première case
If Weekday(DateDébutMois) = vbSaturday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 12632256, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "S"
       End If
 
 If Weekday(DateDébutMois) = vbSunday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 12632256, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "D"
       End If
 
 
If Weekday(DateDébutMois) = vbMonday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "L"
       End If
 
If Weekday(DateDébutMois) = vbTuesday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "M"
       End If
 
If Weekday(DateDébutMois) = vbWednesday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "M"
       End If
 
If Weekday(DateDébutMois) = vbThursday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "J"
       End If
 
If Weekday(DateDébutMois) = vbFriday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "V"
       End If
 
 
 
 'Pour le samedi
 For j = 1 To NbJoursMois - 1
       If Weekday(DateDébutMois + j) = vbSaturday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 12632256, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "S"
        End If
   Next j
 
'Pour le dimanche
For j = 1 To NbJoursMois - 1
If Weekday(DateDébutMois + j) = vbSunday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 12632256, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "D"
       End If
   Next j
 
'Pour le Lundi
For j = 1 To NbJoursMois - 1
If Weekday(DateDébutMois + j) = vbMonday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "L"
       End If
   Next j
 
'Pour le Mardi
For j = 1 To NbJoursMois - 1
If Weekday(DateDébutMois + j) = vbTuesday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "M"
       End If
   Next j
 
'Pour le Mercredi
For j = 1 To NbJoursMois - 1
If Weekday(DateDébutMois + j) = vbWednesday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "M"
       End If
   Next j
 
'Pour le Jeudi
For j = 1 To NbJoursMois - 1
If Weekday(DateDébutMois + j) = vbThursday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "J"
       End If
   Next j
 
'Pour le Vendredi
For j = 1 To NbJoursMois - 1
If Weekday(DateDébutMois + j) = vbFriday Then
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 16777215, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print "V"
       End If
   Next j
 
End Sub
 
Private Sub EntêtePage0_Print(Cancel As Integer, PrintCount As Integer)
   Dim j
 
      'Numéro des jours
  DateDébutMois = DateSerial(Forms![F_InterventionChef]!ChoixAnnée, Forms![F_InterventionChef]!ChoixMoisChefDetail, 1)
  DateFinMois = DateAdd("m", 1, DateDébutMois)
  NbJoursMois = DateFinMois - DateDébutMois
   For j = 1 To NbJoursMois
    'Position du chiffre
      Me.CurrentX = ((j - 0.9) * interv) + MargeGauche
      Me.CurrentY = 13
      Me.FontSize = 8
      Me.FontName = "Arial"
      Me.Print j
   Next j
 
End Sub

merci de ton aide

Bonjour,

Votre code est très complexe,
Je peux donc difficilement intervenir dessus:?

Je peux juste vous donnez un exemple de code possible sur l'évènement format de l'en-tête de groupe2 avec la fonction Format:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Private Sub EntêteGroupe2_Format(Cancel As Integer, FormatCount As Integer)
Dim j
 
Me.Line (MargeGauche, 1)-(MargeGauche + (interv * NbJoursMois - 1), hauteur), 0, B
 
For j = 0 To NbJoursMois - 1
 
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 12632256, BF 'couleur
          Me.Line (MargeGauche + (interv * j), 1)-(MargeGauche + (interv * (j + 1)), hauteur), 0, B 'encadré
        'Position de la lettre
          Me.CurrentX = ((j + 0.4) * interv) + MargeGauche
          Me.CurrentY = 70
          Me.FontSize = 8
          Me.FontName = "Arial"
          Print UCase(Left(Format(DateDébutMois + j, "ddd"), 1))
 
   Next j
 
 
...
 
end sub