Discussion :

[fred24330]

bonjour à tous,

je me suis inspiré d'un exemple de planning sur ce site pour créer une GMAO.
il y a les créneaux horaires ainsi que la périodicité qui fonctionne bien.

un petit souci quand je crée un rdv avec une périodicité, et que ce créneau horaire est déjà occupé, j'ai un message me disant "planifier dans + 15 min ou -15 min ..... car il existe déjà un rdv à ce créneau"
jusqu'ici ça fonctionne les rdv qui sont planifiés reste à leur place car , on supprime le nouveau rdv.

question. Y a t il une solution pour ne plus effacer le nouveau rdv et le décaler de +15min ou +30min voir plus s'il est en conflit avec un autre rdv?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
For j = 1 To 7
 
   If Periodicite(Jour, frm) Then
 
       HD = Jour + HeureDebut
       HF = Jour + HeureFin
 
         If IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD))) Then
 
            rst.AddNew
 
            rst!HoraireDebut = HD
            rst!HoraireFin = HF
            rst!NC = Nz(Forms!F_RendezVous!NC, 0)
            rst!Memo = Nz(Forms!F_RendezVous!Memo, "")
            rst!TypeRdv = Forms!F_RendezVous!TypeRdv
            rst!NE = Forms!F_RendezVous!IdEmploye
            rst!IdPeriodicite = frm!IdPeriodicite
            rst.Update
 
             i = i + 1
 
         Else
 
            MsgBox ("Replannifier intervention 15 min avant ou 15 min aprés en supprimant la periodicité de créer car Il y a déja un rendez-vous pour cette heure le " & Format(Jour, "dd/mm/yyyy"))
 
         End If
 
   End If
 
   If (frm!FinPeriodicite = 2) Then
      If i = Nz(frm!NbreOccurrences, 0) Then
         Exit For
      End If
   End If
 
Jour = Jour + 1
 
Next j
 
rst.Close: Set rst = Nothing
 
End Sub

merci pour votre aide

fred

[User]

Bonjour,

Peut-être en utilisant une autre boucle, tant que le rdv est occupé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
For j = 1 To 7
 
   If Periodicite(Jour, frm) Then
 
       HD = Jour + HeureDebut
       HF = Jour + HeureFin
 
         Do while Not IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)))
 
         HD = HD + #00:15:00#
         HF = HF + #00:15:00#        
 
         Loop        
 
            rst.AddNew
 
            rst!HoraireDebut = HD
            rst!HoraireFin = HF
            rst!NC = Nz(Forms!F_RendezVous!NC, 0)
            rst!Memo = Nz(Forms!F_RendezVous!Memo, "")
            rst!TypeRdv = Forms!F_RendezVous!TypeRdv
            rst!NE = Forms!F_RendezVous!IdEmploye
            rst!IdPeriodicite = frm!IdPeriodicite
            rst.Update
 
             i = i + 1
 
         Else
 
            MsgBox ("Replannifier intervention 15 min avant ou 15 min aprés en supprimant la periodicité de créer car Il y a déja un rendez-vous pour cette heure le " & Format(Jour, "dd/mm/yyyy"))
 
         End If
 
   End If
 
   If (frm!FinPeriodicite = 2) Then
      If i = Nz(frm!NbreOccurrences, 0) Then
         Exit For
      End If
   End If
 
Jour = Jour + 1
 
Next j
 
rst.Close: Set rst = Nothing
 
End Sub

Cdlt,

[fred24330]

nickel ca marche
je le test et retest ca fonctionne

merci beaucoup

[User]

Tant mieux que ce soit du 1er coup

[fred24330]

re,

enfaite ça ne marche pas du premier coup.
ça marche très bien pour la semaine mais quand je planifie dans la temps c'est la merdouille.
le msg box s'affiche. je pense que je dois avoir un souci sur le weekend, car si je fais un périodicité qui ne dépasse pas le weekend ça fonctionne

[User]

Hello,

peux-tu poster le code complet ?

à+

[fred24330]

re,

je te passe le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
Option Compare Database
 
Function DebutSemaine(ByVal DateSemaine As Date, ByVal WD As Integer) As Date
Dim i As Integer
i = Weekday(DateSemaine, vbMonday)
 
   'If (i <= WD) Then
 
      DebutSemaine = DateAdd("d", (WD - i), DateSemaine)
 
   'Else
 
      'DebutSemaine = DateAdd("d", WD - i + 7, DateSemaine)
 
   'End If
 
 
End Function
 
Function NumJourSemaine(ByVal Jour As Date) As Long
Dim dt As Date, WD1 As Integer, WD2 As Integer
 
dt = DateSerial(Year(Jour), Month(Jour), 1)
WD1 = Weekday(dt, vbMonday)
WD2 = Weekday(Jour, vbMonday)
 
   If WD1 <= WD2 Then
      dt = DateAdd("d", (WD2 - WD1), dt)
   Else
      dt = DateAdd("d", (WD2 - WD1) + 7, dt)
   End If
 
NumJourSemaine = (DateDiff("d", dt, Jour) \ 7) + 1
 
End Function
 
 
Function DebutMois1(ByVal DateMois As Date, ByVal MD As Integer) As Date
 
Dim i As Integer
i = Day(DateMois)
 
   If (i <= MD) Then
 
      DebutMois1 = DateSerial(Year(DateMois), Month(DateMois), MD)
 
   Else
 
      DebutMois1 = DateSerial(Year(DateMois), Month(DateMois) + 1, MD)
 
   End If
 
 
End Function
 
Function DebutMois2(ByVal DateMois As Date, ByVal WD As Integer) As Date
 
DebutMois2 = DebutSemaine(DateMois, WD)
 
End Function
 
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
 
  joursFeries(9) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
 
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        ' Lundi de Pâques = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function
 
Function Work_Days(BegDate As Variant, EndDate As Variant, _
                   Optional bAvecJFerie As Boolean = True) As Variant
    Dim dt As Date
 
On Error GoTo Work_Days_Error
    If IsNull(BegDate) Or IsNull(EndDate) Then Err.Raise vbObjectError + 1
    If Not IsDate(BegDate) Or Not IsDate(EndDate) Then Err.Raise vbObjectError + 2
    If BegDate > EndDate Then Err.Raise vbObjectError + 3
 
    dt = BegDate
    Work_Days = 0
    While dt <= EndDate
        If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
            Work_Days = Work_Days + 1
        End If
        dt = DateAdd("d", 1, dt)
    Wend
    Exit Function
 
Work_Days_Error:
    Select Case Err.Number
        Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Work_Days = "Format de date incorrect."
        Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
        Case Else: Work_Days = Err.Description
    End Select
End Function
 
Public Function Periodicite(ByVal Jour As Date, ByVal frm As Form) As Boolean
' Teste si le jour entré en argument est pris en compte par la périodicité définie sur le formulaire "F_Periodicite".
 
Dim j As Long, DateDebut As Date, ns As Integer
Dim Period As Boolean
 
   Period = False
 
   If Jour >= frm!DateDebutPeriodicite Then
 
   If (frm!PeriodiciteJours = 1) And (Nz(frm!PeriodeJours, 0) <> 0) Then
 
      j = DateDiff("d", frm!DateDebutPeriodicite, Jour)
 
 
         Select Case frm!FinPeriodicite
 
         Case 1
         Period = Period Or ((j Mod frm!PeriodeJours) = 0)
 
         Case 2
         Period = Period Or (((j Mod frm!PeriodeJours) = 0) And ((j \ frm!PeriodeJours) <= Nz(frm!NbreOccurrences, 0)))
 
         Case 3
         Period = Period Or (((j Mod frm!PeriodeJours) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         End Select
 
   ElseIf (frm!PeriodiciteJours = 2) Then
 
      Select Case frm!FinPeriodicite
 
      Case 1
      Period = Period Or (Not (EstFerie(Jour)) And (EstWeek(Jour)))
 
      Case 2
      j = Work_Days(frm!DateDebutPeriodicite, Jour)
      Period = Period Or ((Not (EstFerie(Jour)) And (EstWeek(Jour))) And (j <= frm!NbreOccurrences))
 
      Case 3
      Period = Period Or ((Not (EstFerie(Jour)) And (EstWeek(Jour))) And (Jour <= frm!DateFinPeriodicite))
 
      End Select
 
   End If
 
   If Nz(frm!PeriodeSemaines, 0) <> 0 Then
 
      Select Case frm!FinPeriodicite
 
      Case 1
 
         Select Case Weekday(Jour, vbMonday)
 
         Case 1
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 1)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!LundiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
         Case 2
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 2)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!MardiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
         Case 3
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 3)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!MercrediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
         Case 4
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 4)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!JeudiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
         Case 5
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 5)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!VendrediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
         Case 6
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 6)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!SamediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
         Case 7
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 7)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!DimanchePeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0))
 
 
         End Select
 
 
      Case 2
 
         Select Case Weekday(Jour, vbMonday)
 
         Case 1
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 1)
         j = DateDiff("d", DateDebut, Jour)
 
         Period = Period Or ((frm!LundiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(CLng(frm!NbreOccurrences), 0)))
 
         Case 2
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 2)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!MardiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(frm!NbreOccurrences, 0)))
 
         Case 3
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 3)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!MercrediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(frm!NbreOccurrences, 0)))
 
         Case 4
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 4)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!JeudiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(frm!NbreOccurrences, 0)))
 
         Case 5
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 5)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!VendrediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(frm!NbreOccurrences, 0)))
 
         Case 6
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 6)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!SamediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(frm!NbreOccurrences, 0)))
 
         Case 7
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 7)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!DimanchePeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And ((j \ (frm!PeriodeSemaines * 7)) <= Nz(frm!NbreOccurrences, 0)))
 
 
         End Select
 
      Case 3
 
      Select Case Weekday(Jour, vbMonday)
 
         Case 1
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 1)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!LundiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         Case 2
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 2)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!MardiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         Case 3
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 3)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!MercrediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         Case 4
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 4)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!JeudiPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         Case 5
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 5)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!VendrediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         Case 6
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 6)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!SamediPeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
         Case 7
         DateDebut = DebutSemaine(frm!DateDebutPeriodicite, 7)
         j = DateDiff("d", DateDebut, Jour)
         Period = Period Or ((frm!DimanchePeriodeSemaines) And ((j Mod (frm!PeriodeSemaines * 7)) = 0) And (Jour <= frm!DateFinPeriodicite))
 
 
         End Select
 
 
      End Select
 
   End If
 
   If (frm!PeriodiciteMois = 1) And (Nz(frm!JourPeriodeMois, 0) <> 0) And (Nz(frm!PeriodeMois1, 0) <> 0) Then
 
      DateDebut = DebutMois1(frm!DateDebutPeriodicite, frm!JourPeriodeMois)
      j = DateDiff("m", DateDebut, Jour)
 
      Select Case frm!FinPeriodicite
 
      Case 1
      Period = Period Or ((Day(Jour) = frm!JourPeriodeMois) And ((j Mod frm!PeriodeMois1) = 0))
 
      Case 2
      Period = Period Or ((Day(Jour) = frm!JourPeriodeMois) And ((j Mod frm!PeriodeMois1) = 0) And ((j \ frm!PeriodeMois1) <= Nz(frm!NbreOccurrences, 0)))
 
      Case 3
      Period = Period Or ((Day(Jour) = frm!JourPeriodeMois) And ((j Mod frm!PeriodeMois1) = 0) And (Jour <= frm!DateFinPeriodicite))
 
      End Select
 
   ElseIf (frm!PeriodiciteMois = 2) And (Nz(frm!NumJourSemainePeriodeMois, 0) <> 0) And (Nz(frm!JourSemainePeriodeMois, 0) <> 0) And (Nz(frm!PeriodeMois2, 0) <> 0) Then
 
      DateDebut = DebutMois2(frm!DateDebutPeriodicite, frm!JourSemainePeriodeMois)
      j = DateDiff("m", DateDebut, Jour)
      ns = NumJourSemaine(Jour)
 
      Select Case frm!FinPeriodicite
 
      Case 1
      Period = Period Or ((Weekday(Jour, vbMonday) = frm!JourSemainePeriodeMois) And (ns = frm!NumJourSemainePeriodeMois) And ((j Mod frm!PeriodeMois2) = 0))
 
      Case 2
      Period = Period Or ((Weekday(Jour, vbMonday) = frm!JourSemainePeriodeMois) And (ns = frm!NumJourSemainePeriodeMois) And ((j Mod frm!PeriodeMois2) = 0) And ((j \ frm!PeriodeMois2) <= frm!NbreOccurrences))
 
      Case 3
      Period = Period Or ((Weekday(Jour, vbMonday) = frm!JourSemainePeriodeMois) And (ns = frm!NumJourSemainePeriodeMois) And ((j Mod frm!PeriodeMois2) = 0) And (Jour <= frm!DateFinPeriodicite))
 
      End Select
 
   End If
 
   If (frm!PeriodiciteAnnees = 1) And (Nz(frm!JourPeriodeAnnees, 0) <> 0) And (Nz(frm!MoisPeriodeAnnees1, 0) <> 0) Then
 
      DateDebut = DebutMois1(frm!DateDebutPeriodicite, frm!JourPeriodeAnnees)
      j = DateDiff("yyyy", DateDebut, Jour)
 
      Select Case frm!FinPeriodicite
 
      Case 1
      Period = Period Or ((Day(Jour) = frm!JourPeriodeAnnees) And (Month(Jour) = frm!MoisPeriodeAnnees1) And (j > 0))
 
      Case 2
      Period = Period Or ((Day(Jour) = frm!JourPeriodeAnnees) And (Month(Jour) = frm!MoisPeriodeAnnees1) And (j > 0) And (j <= Nz(frm!NbreOccurrences, 0)))
 
      Case 3
      Period = Period Or ((Day(Jour) = frm!JourPeriodeAnnees) And (Month(Jour) = frm!MoisPeriodeAnnees1) And (j > 0) And (Jour <= frm!DateFinPeriodicite))
 
      End Select
 
   ElseIf (Nz(frm!NumJourSemainePeriodeAnnees, 0) <> 0) And (Nz(frm!JourSemainePeriodeAnnees, 0) <> 0) And (Nz(frm!MoisPeriodeAnnees2, 0) <> 0) Then
 
      DateDebut = DebutMois2(frm!DateDebutPeriodicite, frm!JourSemainePeriodeAnnees)
      j = DateDiff("yyyy", DateDebut, Jour)
      ns = NumJourSemaine(Jour)
 
      Select Case frm!FinPeriodicite
 
      Case 1
      Period = Period Or ((Weekday(Jour, vbMonday) = frm!JourSemainePeriodeAnnees) And (ns = frm!NumJourSemainePeriodeAnnees) And (Month(Jour) = frm!MoisPeriodeAnnees2) And (j > 0))
 
      Case 2
      Period = Period Or ((Weekday(Jour, vbMonday) = frm!JourSemainePeriodeAnnees) And (ns = frm!NumJourSemainePeriodeAnnees) And (Month(Jour) = frm!MoisPeriodeAnnees2) And (j > 0) And (j <= Nz(frm!NbreOccurrences, 0)))
 
      Case 3
      Period = Period Or ((Weekday(Jour, vbMonday) = frm!JourSemainePeriodeAnnees) And (ns = frm!NumJourSemainePeriodeAnnees) And (Month(Jour) = frm!MoisPeriodeAnnees2) And (j > 0) And (Jour <= frm!DateFinPeriodicite))
 
      End Select
 
   End If
 
   End If
 
Periodicite = Period
 
End Function
 
Public Sub MajRendezVous(ByVal frm As Form, ByVal HeureDebut As Date, ByVal HeureFin As Date)
 
Dim Jour As Date
Dim j As Long, HD As Date, HF As Date, f As Long, i As Long
Dim rst As DAO.Recordset
 
Jour = frm!DateDebutPeriodicite
i = 0
 
   If frm.FinPeriodicite = 1 Then
      f = 3652
   ElseIf frm.FinPeriodicite = 2 Then
      f = 3652
   ElseIf frm.FinPeriodicite = 3 Then
      f = DateDiff("d", Jour, CDate(frm!DateFinPeriodicite)) + 1
   End If
 
Set rst = CurrentDb.OpenRecordset("T_RendezVous")
 
   If (Jour = CDate(Forms!F_RendezVous!DateRdV1)) Then
      Jour = CDate(Forms!F_RendezVous!DateRdV1) + 1
   End If
 
For j = 1 To f
 
   If Periodicite(Jour, frm) Then
 
       HD = Jour + HeureDebut
       HF = Jour + HeureFin
 
         'If IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD))) Then
        Do While Not IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)))
 
        HD = HD + #12:15:00 AM#
        HF = HF + #12:15:00 AM#
 
        Loop
 
            rst.AddNew
 
            rst!HoraireDebut = HD
            rst!HoraireFin = HF
            rst!NC = Nz(Forms!F_RendezVous!NC, 0)
            rst!Memo = Nz(Forms!F_RendezVous!Memo, "")
            rst!TypeRdv = Forms!F_RendezVous!TypeRdv
            rst!NE = Forms!F_RendezVous!IdEmploye
            rst!IdPeriodicite = frm!IdPeriodicite
            rst.Update
 
             i = i + 1
 
         Else
 
            MsgBox ("Replannifier intervention 15 min avant ou 15 min aprés en supprimant la periodicité de créer car Il y a déja un rendez-vous pour cette heure le " & Format(Jour, "dd/mm/yyyy"))
 
         End If
 
   If (frm!FinPeriodicite = 2) Then
      If i = Nz(frm!NbreOccurrences, 0) Then
         Exit For
      End If
   End If
 
Jour = Jour + 1
 
Next j
 
rst.Close: Set rst = Nothing
 
End Sub

le décalage de 15 min ou plus marche ( conflit avec un autre rdv)bien mais j'ai le message "msg box" dés que je suis en wk end.

[User]

il faut enlever le :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
else
msgbox("...")

et garder le :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
end if

Cdlt,

[fred24330]

désolé de répondre au si tard merci mais quand j'ai eu fini de taper les textes, j'ai percuté qu'il fallait que je fasse cela
merci encore
fred

[User]

Merci de clore le sujet

[fred24330]

bonsoir,

je ne comprends pas pourquoi ça ne me prend pas en compte les rendez vous lorsque je décale sur une heure.
les 3 premiers rendez vous fonctionnent bien et des qu'il se décale d'un de plus, ca me perd des données et mon rdv ne marche pas.

je suis au formatdateUS et quand je rentre mon quart d'heure en plus ça me marque:
HD = HD + #12:15:00 AM#
pareil pour HF

je ne sais pas si j'ai été assez clair.
fred

[User]

Bonsoir,

Avez-vous modifié le code ?

C'est étonnant que vous perdiez des données, car il n'y a nulle part de suppression d'enregistrement.

A priori, je pencherais pour des rendez-vous déjà présents sur cette plage horaire.

Pouvez-vous poster une copie de votre fichier que je puisses mieux diagnostiquer le problème ?

Cdlt,

[fred24330]

bonjour,

le code est déjà affiché un peu plus haut.
il s'agit bien de rendez vous déjà présent sur la plage horaire.
avec le bouclage de 15 min , cela me décale le rdv de 15min jusqu'à ce qu'il me trouve un créneau libre.

au niveau du formulaire ça marche bien.
mais lors de l'ouverture de mon sous formulaire (correspondant à mon créneau horaire de 15 min) je me trouve avec des données manquantes comme NE ou NC qui ne s'affiche pas.
donc msg box "saisie incomplète".

hier je faisais des tests et je me suis aperçu que cela fonctionné correctement jusqu'au 4éme décalage.
je pense qu'il y a un conflit avec le décalage sur une autre heure.

fred

[User]

Bonjour,

Je crois qu'il faudrait mettre un point d'arret avant la comparaison :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Do While Not IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)))
HD = HD + #12:15:00 AM#
HF = HF + #12:15:00 AM#
 
Loop

Et tester les valeurs de Forms!F_RendezVous!IdEmploye en déplaçant la souris sur ce paramètre.

Cdlt,

[fred24330]

bonsoir,

peux tu m'expliquer un peu mieux?
fred

[User]

Je n'en suis pas sûr mais il me semble que la valeur de Forms!F_RendezVous!IdEmploye pourrait-être nulle, donc pour le vérifier tu peux essayer de mettre une fonction de débogage, comme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
debug.print Forms!F_RendezVous!IdEmploye
 
Do While Not IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)))
HD = HD + #12:15:00 AM#
HF = HF + #12:15:00 AM#
 
Loop

Et regarde ensuite ce qui s'affiche dans la fenêtre d'exécution, dans l'éditeur VB.

à+

[fred24330]

bonjour,

je viens faire et refaire des tests et je viens de m’apercevoir à quel moment ca ne fonctionne pas.
je crée un Rdv avec Heure début 8:00 et heure fin 8:15, la boucle fonctionne en décalage à 8:15 - 8:30 et 8:30 - 8:45
mais lorsque je change d'heure HD 8:45 et HF 9:00, j'ai des données qui se perdent et je n'arrive plus à valider mon rendez vous.

je viens de refaire un test avec un HD 8:45 HF 9:00 dés que la périodicité décale le Rdv, je me retrouve avec des pertes de données.

merci de me donner un coup de pouce.

fred

[User]

Bonjour,

Pouvez-vous tester sur la version jointe ?

Vous pouvez également me joindre par mail.

Cdlt,

[fred24330]

alors..... sur le planning tu as crée un RDv de marchand, au niveau du formulaire ça fonctionne
par contre quand tu clics sur la fenêtre "MARCHAND" alors tu te retrouves avec le même problème.
c'est a dire que tu as ton champ "client" où Marchand doit apparaitre ,n’apparait plus. Si tu veux clicker sur OK tu as le message "saisie incorrect" qui apparait.

le bouton d'ouverture formulaire F_client fonctionne, mais il marque le premier nom de la liste et non marchand.

sinon j'ai pris cette version pour faire mon agenda préventif.

fred

[User]

Bonjour,

Cela vient des dates, l'ajout successif de 15 minutes provoque un léger décalage d'un chouia, et Access sauvagarde une date légèrement fausse, si bien que le créneau horaire cliqué sur le planning, ne correspond plus avec la date sauvegardée.

Encore un truc bizarre et inattendu

Voici le code légèrement corrigé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
If Periodicite(Jour, frm) Then
 
       HD = Jour + HeureDebut
       HF = Jour + HeureFin
 
        n = 0
         While Not IsNull(DLookup("[NR]", "T_RendezVous", "(NE= " & Nz(Forms!F_RendezVous!IdEmploye, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)))
             HD = DateAdd("n", 15, HD)
             HF = DateAdd("n", 15, HF)
             n = n + 15
         Wend
 
            HD = DateAdd("n", n, Jour + HeureDebut)
            HF = DateAdd("n", n, Jour + HeureFin)

L'ajout des minutes se fait uniquement à la fin de la boucle...

Cdlt,