Discussion :

[Harbor66]

Le message obtenu avec ce code est "élément non trouvé dans cette collection" le SF_EDTProfesseur ne s'affiche donc pas. Je pense que l'erreur tourne dans la Maj du planning (EDTProfesseur) et qu'il ne reconnait pas le champ "IdDisponibilités".

Le code que je vous ai fait parvenir vous semble t'il correct?

Je veux bien vous envoyer la base mais cela finit par me gêner de vous solliciter aussi souvent surtout que je n'ai pas encore fini et que j'aurais encore d'autres questions lorsqu'il s'agira d'affecter un cours à la disponibilité d'une salle.

Si vous maintenez votre offre dites moi si je dois vous faire parvenir cette base en MP.

Merci encore

Roland

[User]

bonjour,

non, pas de soucis

il faudrait ajouter le champ "iddisponibilite" dans la requête source "r_planning".

Cdlt,
Denis

[Harbor66]

Je vous joins comme convenu la base concernée. Le champ "IdDisponibilités est déjà dans la requête R_EProfesseur

Merci d'avance

Roland

[User]

Voila ce que j'ai pu obtenir.

Regardez bien dans la requête source et dans le code ce que j'ai modifié pour que ça fonctionne...

Cdlt,

[Harbor66]

Et oui c'est la grande différence entre les Pros et les amateurs occasionnels comme moi !! Je dois dire que je n'en était pas loin mais j'ai du mal avec le vb

Je reviens à une question de l'un de mes derniers posts : suis je limité en nombre dans l'utilisation de case d'option ?. J'ai vu dans votre code que vous l'aviez limité à 12. Moi, j'aurais un besoin de 325 couleurs différents donc autant de case d'option.

De grands merci encore

Roland

[User]

Dans ce cas, il faudrait créer une liste déroulante basée sur le champ "TypeRdv" à la place du groupe d'options à droite du formulaire de saisie.

Cette liste déroulante se nommerait "TypeRdv" et serait alimentée par la table "T_CouleurRdv".

Nbre de colonnes : 2
Colonne liée : 1
Largeurs colonnes : 0 cm; 6 cm


Ensuite, ajouter un bouton de commande pour choisir la couleur à affecter au "type de rdv" avec ce 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
Private Sub CmdCouleur_Click()
Dim newColor As Long
Dim rst As DAO.Recordset
Dim db As DAO.Database
 
    newColor = aDialogColor(Me!TypeRdv.BackColor)
    If newColor <> -1 Then
       Set db = CurrentDb
       Set rst = db.OpenRecordset("select Couleur From T_CouleurRdv where NCouleur=" & Nz(Me!TypeRdv, 0), dbOpenDynaset)
 
       If Not rst.EOF Then
          rst.Edit
          rst!Couleur = newColor
          rst.Update
 
          Me!TypeRdv.BackColor = newColor
 
       End If
 
       rst.Close
       Set rst = Nothing
 
       db.Close
       Set db = Nothing
 
    End If
 
End Sub

Il faudrait déjà alimenter la table T_CouleurRdv avec le libellé des couleurs.

Cdlt,

[Harbor66]

Bonjour,
J’essaie désespérément de modifier la Maj_Planning.
Je souhaite incorporer une condition pour cette Maj cad interdire la mise à jour dans le cas où un cours 1 (ex : BTS 1_Anglais langue vivante 1) est donné par un autre Professeur (ex Cours 2= BTS 1_Français) le même jour à la même période de date, avec un message correspondant. J’ai donc modifié le code comme suit :

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
Public Sub MajEDTProfesseur()
' La procedure de mise à jour des rendez-vous sur le planning en fonction de la date de début :
' La procedure selectionne dans la table T_RendezVous les RDV compris entre la date de début (DateDebut) et la date de debut + 7 jours (DateDebut+7),
' puis met à jour le planning avec ces rendez-vous.
' Pour chaque RDV l'horaire de début et l'horaire de fin permettent de dimensionner le label correspondant au creneau horaire du début.
 
On Error GoTo Err_MajEDTProfesseur
 
Dim RsPL As DAO.Recordset
Dim Ligne As Integer, Col As Integer
'Dim LeSQL As String
Dim strSqlCours As String
Dim rsCours As DAO.Recordset
Dim i As Integer, D As Integer
Dim Color As Long
 
' Sélectionne les RDV compris entre DateDebut et DateDebut+7
 
 
    ' Initialisation de la requete permettant de récupérer les dates d'occupation du Cours sélectionné pendant la période choisie
    strSqlCours = "SELECT R_Cours" & _
                                       "FROM R_EProfesseur " & _
                                       "WHERE ((IdProfesseur= " & Nz(Forms!F_EDTProfesseur!IdProfesseur, 0) & ") and (R_EProfesseur.HoraireDebut between " & FormatDateUS(DateDebut) & " And " & FormatDateUS(DateDebut + 7) & ")"
 
    ' Récupération des données
    Set rsCours = CurrentDb.OpenRecordset(strSqlCours)
 
    ' Contrôle de l'occupation.
    If ((Forms!F_EDTProfesseur!Cours <> "") And Not IsNull(Forms!F_EDTProfesseur!Cours)) Then
 
        'MsgBox "La Classe est déjà en Cours à cette date." & vbCrLf & "Veuillez revoir votre choix", vbInformation, cstDVP
    Else
 
    End If
 
'Forms!F_EDTProfesseur!Titre.Caption = "EDTProfesseur DE LA SEMAINE DU " & UCase(Format(DateDebut, "dd mmmm yyyy")) & " AU " & UCase(Format(DateDebut + 6, "dd mmmm yyyy"))
'Forms!F_EDTProfesseur!DateD.Value = DateDebut
 
' initialise le EDTProfesseur
InitEDTProfesseur
 
MajPostItProfesseur
 
   Do While Not (RsPL.EOF) ' on parcours les RDV
 
      If Not IsNull(RsPL!Couleur) Then
         Color = RsPL!Couleur ' définit la couleur du label.
 
      Else
         Color = vbWhite
 
      End If
 
         Col = IndiceColonne(RsPL!HoraireDebut)
         Ligne = PremierCreneau(RsPL!HoraireDebut)
 
         D = DateDiff("n", RsPL!HoraireDebut, RsPL!HoraireFin) \ TrancheHoraire ' on determine le Libellébre de creneaux horaires correspondants à la durée du rdv
 
         With goEDTProfesseur
 
'If Forms!F_EDTProfesseur!LibelléDisponibilités.Value = "" Then
 
       If Not IsNull(RsPL!IdDisponibilités) Then
         .DrawRect Ligne, Col, (Ligne + D - 1), Col, Color, vbBlack, 1
         .DrawText Ligne, Col, (Ligne + D - 1), Col, Nz(RsPL!Memo, ""), 12, 1, 1, vbBlack, False
         .DrawText Ligne, Col, (Ligne + D - 1), Col, Nz(RsPL!LibelléDisponibilités, ""), 12, 1, 1, vbBlack, False
         Else
         .DrawRect Ligne, Col, (Ligne + D - 1), Col, Color, vbBlack, 1
         .DrawText Ligne, Col, (Ligne + D - 1), Col, Nz(RsPL!Cours, ""), 12, 1, 1, vbBlack, False
         .DrawText Ligne, Col, (Ligne + D - 1), Col, Nz(RsPL!Memo, ""), 12, 1, 1, vbBlack, False
       End If
 
 ' End If
 
 
 
         End With
 
   RsPL.MoveNext
   Loop
 
' libération
 
goEDTProfesseur.KeepImage
goEDTProfesseur.Refresh
 
RsPL.Close
Set RsPL = Nothing
 
Exit_MajEDTProfesseur:
    Exit Sub
 
Err_MajEDTProfesseur:
    Set goHeader = Nothing
    Set goEDTProfesseur = Nothing
    MsgBox Err.description
    Resume Exit_MajEDTProfesseur
 
End Sub

Mais bien sur cela ne fonctionne pas comme d’habitude

Merci

Roland

[User]

Bonjour,

C'est au niveau de la procédure de validation sur le formulaire de saisie qu'il faut agir :

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
Private Sub CmdValider_Click()
' Valide les choix effectués sur le formulaire "F_EProfesseur".

On Error GoTo Err_CmdValider

Dim n As Long
Dim HD As Date, HF As Date

' Si les zones de texte "Cours" ou "Memo" ne sont pas vides
'Forms!F_EProfesseur!IdDisponibilités.Value = IsNull
 If ((Me!Cours <> "") And Not IsNull(Me!Cours)) Or _
 ((Me!Memo <> "") And Not IsNull(Me!Memo)) Then
   HD = CDate(Me!DateRdV1) + CDate(Me!HoraireD)
   HF = CDate(Me!DateRdV2) + CDate(Me!HoraireF)

' Si les zones de texte "Disponibilités" ou "Memo" ne sont pas vides
Else
'Forms!F_EProfesseur!IdDisponibilités.Value = Not IsNull
   If ((Me!IdDisponibilités <> "") And Not IsNull(Me!IdDisponibilités)) Or _
 ((Me!Memo <> "") And Not IsNull(Me!Memo)) Then
   HD = CDate(Me!DateRdV1) + CDate(Me!HoraireD)
   HF = CDate(Me!DateRdV2) + CDate(Me!HoraireF)
 End If
 End If
      If (Format(HF, "hh:nn") <= Format(HeureFin, "hh:nn")) And (HD < HF) Then
      
' On recherche des RDV dont les horaires de début et de fin chevauchent les
' horaires choisis sur le formulaire.
      
  n = Nz(DLookup("[NR]", "T_EProfesseur", "(NR<>" & Nz(Me!NR, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)
            
' si aucun RDV n'a été trouvé, la plage horaire est donc disponible et on peut
' enregistrer le RDV.
      
         If (n = 0) Then
         Me!HoraireDebut = HD
         Me!HoraireFin = HF
         Me.Requery
         MajEDTProfesseur
         DoCmd.Close
      
         Else
         MsgBox ("Saisie incorrecte !")
      
         End If
             
      Else
      MsgBox ("Saisie incorrecte !")
             
      End If
      

  

Exit_CmdValider:
    Exit Sub

Err_CmdValider:
    Set goHeader = Nothing
    Set goEDTProfesseur = Nothing
    MsgBox Err.description
    Resume Exit_CmdValider
End Sub

La ligne de commande modifiée est en vert.

Cdlt,

[Harbor66]

Merci beaucoup, mais cela ne marche pas au sens ou je l'attendais. Je m'explique :

[Harbor66]

Mille excuses, le message précédent non terminé est parti "tout seul" et n'a donc aucun sens.

La modification du code que vous m’avez fait parvenir ne correspond pas à la fonction recherchée. Je m’explique :

Si un professeur « DURAND » enseigne une matière « Anglais LV1 » à une classe « BTS 1 » et qu’un Professeur « DUPONT » enseigne la matière "Mathématiques" à cette même classe « BTS 1 », il ne faut pas bien sûr que cette même classe puisse apparaitre sur le planning avec ces deux cours « BTS1_Maths » et « BTS1_Anglais » le même jour à la même heure, comme c’est le cas avec le code d’origine.
Le second code quant à lui ne m’autorise qu’un seul cours pour un jour « ex : le lundi de 9h à 11h» quel que soit la classe et le Professeur.
J’ai tenté de remplacer la ligne de code en incorporant « IdClasse » ou « Cours » mais cela ne fonctionne pas du tout.
Voici de nouveau le code sur lequel, j’ai conservé les 3 lignes (l’original, celui que vous m’avez envoyé et celui que j’ai modifié moi-même)

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
 
 
Private Sub CmdValider_Click()
' Valide les choix effectués sur le formulaire "F_EProfesseur".
 
On Error GoTo Err_CmdValider
 
Dim n As Long
Dim HD As Date, HF As Date
 
' Si les zones de texte "Cours" ou "Memo" ne sont pas vides
'Forms!F_EProfesseur!IdDisponibilités.Value = IsNull
 If ((Me!Cours <> "") And Not IsNull(Me!Cours)) Or _
 ((Me!Memo <> "") And Not IsNull(Me!Memo)) Then
   HD = CDate(Me!DateRdV1) + CDate(Me!HoraireD)
   HF = CDate(Me!DateRdV2) + CDate(Me!HoraireF)
 
' Si les zones de texte "Disponibilités" ou "Memo" ne sont pas vides
Else
'Forms!F_EProfesseur!IdDisponibilités.Value = Not IsNull
   If ((Me!IdDisponibilités <> "") And Not IsNull(Me!IdDisponibilités)) Or _
 ((Me!Memo <> "") And Not IsNull(Me!Memo)) Then
   HD = CDate(Me!DateRdV1) + CDate(Me!HoraireD)
   HF = CDate(Me!DateRdV2) + CDate(Me!HoraireF)
 End If
 End If
      If (Format(HF, "hh:nn") <= Format(HeureFin, "hh:nn")) And (HD < HF) Then
 
' On recherche des RDV dont les horaires de début et de fin chevauchent les
' horaires choisis sur le formulaire.
 
       'n = Nz(DLookup("[NR]", "T_EProfesseur", "(IdProfesseur= " & Nz(Me!IdProfesseur, 0) & ") and (NR<>" & Nz(Me!NR, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)
      'n = Nz(DLookup("[NR]", "T_EProfesseur", "(NR<>" & Nz(Me!NR, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)
      n = Nz(DLookup("[NR]", "T_EProfesseur", "(IdClasse < > " & Nz(Me!IdClasse, 0) & ") and (NR<>" & Nz(Me!NR, 0) & ") And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)
' si aucun RDV n'a été trouvé, la plage horaire est donc disponible et on peut
' enregistrer le RDV.
 
         If (n = 0) Then
         Me!HoraireDebut = HD
         Me!HoraireFin = HF
         Me.Requery
         MajEDTProfesseur
         DoCmd.Close
 
         Else
         MsgBox ("Saisie incorrecte !")
 
         End If
 
      Else
      MsgBox ("Saisie incorrecte !")
 
      End If
 
 
 
 
Exit_CmdValider:
    Exit Sub
 
Err_CmdValider:
    Set goHeader = Nothing
    Set goEDTProfesseur = Nothing
    MsgBox Err.description
    Resume Exit_CmdValider
End Sub

Merci

Roland

[User]

Bonjour,

OK, dans ce cas il faut tester s'il y a un enregistrement dont le champ cours contient la même classe.
Il faut donc remplacer la ligne en question dans la procédure de validation par :

Code :

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

1
2
3
4
5
 
...
classe = Nz(DLookup("nomClasse", "T_Classe", "InStr('" & Nz(Me.Cours, "") & "',[nomClasse]) <> 0"), "")
n = Nz(DLookup("[NR]", "T_EProfesseur", "(NR<>" & Nz(Me!NR, 0) & ") And (InStr([Cours],'" & classe & "')<>0) And HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)
...

Cdlt,

[Harbor66]

Merci cela fonctionne et je pense que je vais devoir appliquer la même règle pour le choix de la salle de classe.

Petit hic cependant, le champ Classe semble se substituer au champ Cours ce qui fait que l'affichage sur le planning se fait sous la forme :

"BTS 1" et non "BTS1_Mathèmatiques"

Je cherche sur la Maj Planning

Cdt

Roland

[Harbor66]

J'ai trouvé, j'avais fait une erreur dans les relations et l'ordre de tabulation du F_EProfesseur n'étai pas correct.

Merci

Roland

[User]

Je suis content pour vous mais à l'avenir il faudrait laisser cette discussion pour en ouvrir une autre