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
| Public Sub MajEDT()
' 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_MajEDT
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_SaisieEDT.* " & _
"FROM R_SaisieEDT " & _
"WHERE (IdProfesseur= " & Nz(Forms!F_EDT!cmbTri, 0) & ") and (R_SaisieEDT.HoraireDebut between " & FormatDateUS(DateDebut) & " And " & FormatDateUS(DateDebut + 7) & ")"
Set RsPL = CurrentDb.OpenRecordset(LeSQL, dbOpenForwardOnly)
'Forms!F_EDT!Titre.Caption = "EDT DE LA SEMAINE DU " & UCase(Format(DateDebut, "dd mmmm yyyy")) & " AU " & UCase(Format(DateDebut + 6, "dd mmmm yyyy"))
'Forms!F_EDT!DateD.Value = DateDebut
' initialise le EDT
InitEDT
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 goEDT
'If Forms!F_EDT!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!Cours, "") & vbCrLf & Nz(RsPL!Memo, "") & vbCrLf & Nz(RsPL!Nom, ""), 12, 1, 1, vbBlack, False
.DrawText Ligne, Col, (Ligne + D - 1), Col, Nz(RsPL!Matière, ""), 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
goEDT.KeepImage
goEDT.Refresh
RsPL.Close
Set RsPL = Nothing
Exit_MajEDT:
Exit Sub
Err_MajEDT:
Set goHeader = Nothing
Set goEDT = Nothing
MsgBox Err.description
Resume Exit_MajEDT
End Sub |
Partager