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
| 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 i As Integer, D As Integer
Dim Color As Long
' Sélectionne les RDV compris entre DateDebut et DateDebut+7
LeSQL = "SELECT R_EProfesseur.* " & _
"FROM R_EProfesseur " & _
"WHERE (IdProfesseur= " & Nz(Forms!F_EDTProfesseur!IdProfesseur, 0) & ") and (R_EProfesseur.HoraireDebut between " & FormatDateUS(DateDebut) & " And " & FormatDateUS(DateDebut + 7) & ")"
Set RsPL = CurrentDb.OpenRecordset(LeSQL, dbOpenForwardOnly)
'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
MajPostIt
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 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
Else
.DrawRect Ligne, Col, (Ligne + D - 1), Col, Color, vbBlack, 1
.DrawText Ligne, Col, (Ligne + D - 1), Col, RsPL!Cours, 12, 1, 1, vbBlack, False
End If
'Else
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
Else
.DrawRect Ligne, Col, (Ligne + D - 1), Col, Color, vbBlack, 1
.DrawText Ligne, Col, (Ligne + D - 1), Col, RsPL!IdDisponibilités, 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 |
Partager