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
|
Public Sub MajPlanning()
' 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.
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_RendezVous.* " & _
"FROM R_RendezVous " & _
"WHERE (ID_Salles= " & Nz(Forms!F_Planning!Salles, 0) & ") and (R_RendezVous.HoraireDebut < " & FormatDateUS(DateDebut + 7) & ") And (R_RendezVous.HoraireFin >" & FormatDateUS(DateDebut) & ")"
Set RsPL = CurrentDb.OpenRecordset(leSQL, dbOpenForwardOnly) ' endroit de l'erreur
Forms!F_Planning!Titre.Caption = "PLANNING DE LA SEMAINE DU " & UCase(Format(DateDebut, "dd mmmm yyyy")) & " AU " & UCase(Format(DateDebut + 6, "dd mmmm yyyy"))
Forms!F_Planning!DateD.Value = DateDebut
' initialise le planning
InitPlanning
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
If DateDiff("d", RsPL!HoraireDebut, RsPL!HoraireFin) = 0 Then
Col = IndiceColonne(RsPL!HoraireDebut)
Ligne = PremierCreneau(RsPL!HoraireDebut)
D = DateDiff("n", RsPL!HoraireDebut, RsPL!HoraireFin) \ 15 ' on determine le nombre de creneaux horaires correspondants à la durée du rdv
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).Height = 295 * D 'Hauteur du label = Hauteur de la ligne multipliée par le nombre de créneaux
If Not IsNull(RsPL!ID) Then
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).Caption = CentrerTexte(RsPL!Classes & " / " & RsPL!Professeur & vbCrLf & RsPL!Eleves & vbCrLf & Nz(RsPL!Memo, ""), D)
'& vbCrLf & RsPL!Eleves
'(RsPL!Patient & " [" & RsPL!NP & "]", d)
'Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).Caption = CentrerTexte(Nz(RsPL!Memo, ""), D)
'Else
'Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).Caption = CentrerTexte(Nz(RsPL!L_Professeur, ""), d)
End If
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).BackColor = Color ' colorie le label
Else
' mise à jour du congé
MajCongé RsPL!HoraireDebut, RsPL!HoraireFin, RsPL!Memo, Color
End If
RsPL.MoveNext
Loop
' libération
RsPL.Close
Set RsPL = Nothing
End Sub
Public Function OuvrirFormRendezVous(i As Integer, j As Integer)
' Ouvre le formulaire F_RendezVous sur double-clique d'un label du planning
' prend en arguments les indices de ligne et de colonne.
Dim DateC As Date
Dim DateD As Date ' Jour et Horaire de début.
Dim DateF As Date ' Jour et Horaire de fin.
DateC = IndicesToHoraire(i, j)
' selectionne dans un recordset le rendez-vous correspondant au créneau choisi par
' double-clique.
' s'il y a un RDV alors copier dans les variables DateD et DateF
' les horaires de début et de fin du rdv.
DateD = Nz(DLookup("[HoraireDebut]", "T_RendezVous", "(ID_Salles= " & Nz(Forms!F_Planning!Salles, 0) & ") and HoraireDebut<=" & FormatDateUS(DateC) & " And HoraireFin>" & FormatDateUS(DateC)), DateC)
DateF = Nz(DLookup("[HoraireFin]", "T_RendezVous", "(ID_Salles= " & Nz(Forms!F_Planning!Salles, 0) & ") and HoraireDebut<=" & FormatDateUS(DateC) & " And HoraireFin>" & FormatDateUS(DateC)), DateAdd("n", 15, DateC))
' ouvre le formulaire " F_RendezVous "
DoCmd.OpenForm "F_RendezVous", , , "(ID_Salles= " & Nz(Forms!F_Planning!Salles, 0) & ") and HoraireDebut=" & FormatDateUS(DateD)
Forms!F_RendezVous!DateRdV1 = DateValue(DateD)
Forms!F_RendezVous!DateRdV2 = DateValue(DateF)
Forms!F_RendezVous!HoraireD = Format(DateD, "hh:nn")
Forms!F_RendezVous!HoraireF = Format(DateF, "hh:nn")
Forms!F_RendezVous!Salles = Forms!F_Planning!Salles
End Function
Public Sub MajCouleursRdv()
Dim RS As DAO.Recordset
Dim Coulr As Long
Dim i As Integer
Set RS = _
CurrentDb.OpenRecordset("T_CouleurRdv", dbOpenSnapshot)
RS.MoveFirst
i = 1
Do Until RS.EOF
Coulr = RS!couleur
Forms!F_RendezVous("Etiq" & i).BackColor = Coulr
Forms!F_RendezVous("Etiq" & i).Caption = RS!DescriptionRdv
Forms!F_RendezVous("Etiq" & i).Visible = True
Forms!F_RendezVous("Option" & i).Visible = True
RS.MoveNext: i = i + 1
Loop
While i <= 33
Forms!F_RendezVous("Etiq" & i).BackColor = vbWhite
Forms!F_RendezVous("Etiq" & i).Caption = ""
Forms!F_RendezVous("Etiq" & i).Visible = False
Forms!F_RendezVous("Option" & i).Visible = False
i = i + 1
Wend
RS.Close
End Sub
Public Function FormatDuree(ByVal min As Integer) As String
Dim h As Integer, M As Integer
If min >= 60 Then
h = min \ 60
M = min Mod 60
If M > 0 Then
FormatDuree = h & " h " & M
Else
FormatDuree = h & " h"
End If
Else
FormatDuree = min & " min"
End If
End Function
Public Sub MajCongé(ByVal DateD As Date, ByVal DateF As Date, ByVal Memo As String, ByVal Color As Long)
' Procédure pour afficher les congés sur le planning.
'Dim DateC As Date
'Dim Col As Integer, Ligne As Integer
'Dim D As Integer
'DateC = DateDebut
'For Col = 1 To 7
'If DateC = DateValue(DateD) Then
' Ligne = PremierCreneau(DateD)
' D = DateDiff("n", TimeValue(DateD), #12:00:00 PM#) \ 15
' Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).Height = 295 * D
' Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).Caption = CentrerTexte(Conges, D)
' Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" & Col).BackColor = Color
' ElseIf (DateC > DateD) And (DateC < DateValue(DateF)) Then
' D = DateDiff("n", #8:00:00 AM#, #12:00:00 PM#) \ 15
' Forms!F_Planning!Planning.Form("creneau1_" & Col).Height = 295 * D
' Forms!F_Planning!Planning.Form("creneau1_" & Col).Caption = CentrerTexte(Conges, D)
' Forms!F_Planning!Planning.Form("creneau1_" & Col).BackColor = Color
' ElseIf (DateC = DateValue(DateF)) Then
' D = DateDiff("n", #8:00:00 AM#, TimeValue(DateF)) \ 15
'If D > 0 Then
' Forms!F_Planning!Planning.Form("creneau1_" & Col).Height = 295 * D
' Forms!F_Planning!Planning.Form("creneau1_" & Col).Caption = CentrerTexte(Conges, D)
' Forms!F_Planning!Planning.Form("creneau1_" & Col).BackColor = Color
' End If
'End If
'DateC = DateC + 1
'Next Col
End Sub |
Partager