[AC-2007] générer astreinte du personnel [Résolu]

[hugodu28]

bonjour ,
à partir de l'appli "planning" dispo sur le site j'ai fait un formulaire pour générer automatiquement les astreintes de gardes

j'ai 5 équipes de 1 à 5
l'astreintes est de 7 jours
une date de début de période une date de fin

pour 7 jours, équipe 1, ajout valeur AST dans table "planning"
puis pour 7 jour , équipe 2 , valeur AST dans table "planning"
......
jusqu'à équipe 5
puis on recommence à équipe 1 jusqu'à arriver à date de fin.

Avec le code que j'ai , j'arrive à décaler de 7 jours par équipe mais j'ai AST pour tous les jours jusqu'à la date de fin.

Où est l'erreur de code?

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
 
Private Sub CmdGenererG_Click()
Dim db As DAO.Database, i As Integer
Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset
Dim Date1 As Date, Date2 As Date, DateJ As Date
Dim rep As Integer
 
On Error Resume Next
 
   rep = MsgBox("Voulez-vous mettre à jour les astreintes pour cette période ?", vbYesNo)
 
   If rep = vbYes Then
 
   Date1 = CDate(Me.DateDebut1): Date2 = CDate(Me.DateFin1)
 
   If (Date1 <= Date2) Then
 
      Set db = CurrentDb
 
      Set rst2 = db.OpenRecordset("T_Planning", dbOpenDynaset)
 
      db.Execute "delete * from T_Planning where (CodeG like 'AST') and DateJ between " & FDateUs(Date1) & " and " & FDateUs(Date2)
 
      For i = 1 To 5
 
      Set rst1 = db.OpenRecordset("select * from [RH équipe-matricule] where [matricule]=" & i, dbOpenForwardOnly)
 
      Do Until rst1.EOF
 
      DateJ = Date1 + 7 * i - 7
 
         Do While DateJ <= Date2
 
 
            rst2.AddNew
            rst2!Matricule = rst1!Matricule
            rst2!DateJ = DateJ
            rst2!CodeG = "AST"
            rst2.Update
 
            DateJ = DateJ + 1
 
 
         Loop
 
         rst1.MoveNext
 
      Loop
 
      rst1.Close: Set rst1 = Nothing
 
      Next i
 
 
      Set rst1 = db.OpenRecordset("select * from [rh matricule équipe] where [matricule]=" & i, dbOpenForwardOnly)
 
 
 
      rst2.Close: Set rst2 = Nothing
 
      db.Close: Set db = Nothing
 
      MajPlanning
 
   Else
 
      MsgBox ("Saisir une date de début antérieure ou égale à la date de fin !")
 
   End If
 
   End If
 
End Sub

voici le résultat

Pièce jointe 70891

[Arkham46]

bjr,

1 - retirer le On Error Resume Next qui peut cacher une erreur utile au débogage

2 - ne pas remettre le On Error Resume Next, utiliser On error goto pour gérer l'erreur sans continuer le traitement alors qu'il y a un problème.
cf : http://silkyroad.developpez.com/VBA/...rreurs/#LIII-A

3 - sans commentaires il est difficile de comprendre le code

4 - il y a manifestement un problème dans l'algorithme, qui ne fait pas ce qui est voulu (il va jusqu'à Date2 dans le while, ce n'est pas le bon endroit pour faire cette vérif)

5 - La table [RH équipe-matricule] contient-elle plusieurs équipes pour un matricule? (Le pourquoi de la boucle sur rst1?)

6 - Ecrire l'algo en pseudo code (avec des mots en français) peut être utile avant de se lancer dans le VBA

[User]

Bonnes fêtes

En effet tu peux supprimer le on error resume next, sinon voici un code pour générer les astreintes (AST):

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
 
Private Sub CmdGenererAST_Click()
Dim db As DAO.Database, i As Long
Dim rst1 As DAO.Recordset
Dim Date1 As Date, Date2 As Date, DateJ As Date, DateJ2 As Date
Dim rep As Integer
 
   rep = MsgBox("Voulez-vous mettre à jour les astreintes pour cette période ?", vbYesNo)
 
   If rep = vbYes Then
 
   Date1 = CDate(Me.DateDebut): Date2 = CDate(Me.DateFin)
 
   If (Date1 <= Date2) Then
 
      Set db = CurrentDb
 
      Set rst1 = db.OpenRecordset("T_Planning", dbOpenDynaset)
 
      For i = 1 To 5
 
      If IsNull(DLookup("CodeG", "T_Planning", "(Matricule=" & i & ") and ([CodeG]<>'AST') and [DateJ] between " & FDateUs(Date1) & " and " & FDateUs(Date2))) Then
 
         db.Execute "delete * from T_Planning where (Matricule=" & i & ") and ([CodeG]='AST') and DateJ between " & FDateUs(Date1) & " and " & FDateUs(Date2)
 
         DateJ = Date1 + (i - 1) * 7
         DateJ2 = Date1 + (i * 7) - 1
 
         Do While DateJ <= DateJ2
 
               rst1.AddNew
               rst1!Matricule = i
               rst1!DateJ = DateJ
               rst1!CodeG = "AST"
               rst1.Update
 
            DateJ = DateJ + 1
 
            If DateJ > Date2 Then
               rst1.Close: Set rst1 = Nothing
               db.Close: Set db = Nothing
 
               MajPlanning
 
               Exit Sub
            End If
 
         Loop
 
 
      Else
 
         MsgBox "Période indisponible pour l'équipe " & i
 
      End If
 
      Next i
 
      rst1.Close: Set rst1 = Nothing
 
      db.Close: Set db = Nothing
 
      MajPlanning
 
   Else
 
      MsgBox ("Saisir une date de début antérieure ou égale à la date de fin !")
 
   End If
 
   End If
 
End Sub

A+

[hugodu28]

apres avoir corrigé datedébut1 et date fin1
ça applique bien celon les conditions,
mais lorsque j'arrive au dernier jour pour matricule 5;
ça ne recommence pas à matricule n°1 et ainsi de suite

[User]

Re,

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
Private Sub CmdGenererAST_Click()
Dim db As DAO.Database, i As Long, j As Long
Dim rst1 As DAO.Recordset
Dim Date1 As Date, Date2 As Date, DateJ As Date, DateJ2 As Date
Dim rep As Integer
 
   rep = MsgBox("Voulez-vous mettre à jour les astreintes pour cette période ?", vbYesNo)
 
   If rep = vbYes Then
 
   Date1 = CDate(Me.DateDebut): Date2 = CDate(Me.DateFin)
 
   If (Date1 <= Date2) Then
 
      Set db = CurrentDb
 
      Set rst1 = db.OpenRecordset("T_Planning", dbOpenDynaset)
 
      j = 1: DateJ = Date1
 
      Do While (DateJ <= Date2)
 
      For i = 1 To 5
 
      DateJ = Date1 + (j - 1) * 35 + (i - 1) * 7
      DateJ2 = Date1 + (j - 1) * 35 + (i * 7) - 1
 
      If IsNull(DLookup("CodeG", "T_Planning", "(Matricule=" & i & ") and ([CodeG]<>'AST') and [DateJ] between " & FDateUs(DateJ) & " and " & FDateUs(DateJ2))) Then
 
         db.Execute "delete * from T_Planning where (Matricule=" & i & ") and ([CodeG]='AST') and DateJ between " & FDateUs(DateJ) & " and " & FDateUs(DateJ2)
 
         Do While DateJ <= DateJ2
 
               rst1.AddNew
               rst1!Matricule = i
               rst1!DateJ = DateJ
               rst1!CodeG = "AST"
               rst1.Update
 
            DateJ = DateJ + 1
 
            If DateJ > Date2 Then
               rst1.Close: Set rst1 = Nothing
               db.Close: Set db = Nothing
 
               MajPlanning
 
               Exit Sub
            End If
 
         Loop
 
 
      Else
 
         MsgBox "Période indisponible pour l'équipe " & i
 
      End If
 
      Next i
 
      j = j + 1
 
      Loop
 
      rst1.Close: Set rst1 = Nothing
 
      db.Close: Set db = Nothing
 
      MajPlanning
 
   Else
 
      MsgBox ("Saisir une date de début antérieure ou égale à la date de fin !")
 
   End If
 
   End If
 
 
End Sub

[hugodu28]

impécable!!!
merci et bonne fêtes