Créer un formulaire d'agenda avec Access

SELECT T_Client.IdClient, [NomClient] & " " & [PrenomClient] AS Client
FROM T_Client
ORDER BY [NomClient] & " " & [PrenomClient];

Client: [NomClient] & " " & [PrenomClient]

Option Compare Database
Option Explicit
' Module de l'application pour gérer le planning.

' Dans la partie déclaration du module on définit les variables contenant les valeurs des paramètres du planning.

Public dateDebut As Date ' variable indiquant la date du 1er jour du planning
Public TrancheHeure As Long ' variable indiquant la tranche des heures (10 min, 15 min, 30 min, ...)
Public HeureDebut As String ' variable indiquant heure de début (08:00, 09:00, ...)
Public nblignes As Long ' variable indiquant le nombre de lignes du planning
Public hauteurlignes As Long ' variable indiquant la hauteur des lignes du planning

'...

Public Function FormatDateUS(laDate As Date) As String
    ' Formate la date passée en argument en date US
    FormatDateUS = Chr(35) & Format(laDate, "mm-dd-yyyy hh:nn:ss") & Chr(35)  ' Date au format US
End Function

Private Function EstWeekEnd(laDate As Date)
    EstWeekEnd = ((Weekday(laDate) = 1) Or (Weekday(laDate) = 7)) ' est sur un week-end
End Function

Function DebutSemaine(ByVal DateSemaine As Date) As Date
    'Prend en argument un jour dans la semaine choisie et renvoie la date du premier jour de cette semaine
    Dim i As Long
    i = Weekday(DateSemaine, vbMonday)
    DebutSemaine = DateAdd("d", -i + 1, DateSemaine)    
End Function

Private Function IndiceTrancheHeure(ByVal DateHeureDebut As Date) As Long
    ' La fonction prend en argument la date et l'heure de début du rendez-vous et
    ' renvoie l'indice de la 1re tranche d'heure du RDV.
    IndiceTrancheHeure = (DateDiff("n", TimeValue(HeureDebut), TimeValue(DateHeureDebut)) / TrancheHeure) + 1
    
End Function

Private Function IndiceColonne(ByVal dtRdv As Date) As Long
    ' La fonction prend en argument la date du RDV et
    ' renvoie l'indice de la colonne du jour correspondant sur le planning.
    IndiceColonne = DateDiff("d", dateDebut, dtRdv) + 1
End Function

Private Function DateHeureTrancheHeure(ByVal indLigne As Long, ByVal indColonne As Long) As Date
    'La fonction prend en argument les indices de ligne (horaire) et
    'de colonne (jour) sur le planning et renvoie la date et l'heure correspondantes.
    Dim dtCur As Date
    Dim h As Long ' heures
    Dim m As Long ' minutes
    
    dtCur = DateAdd("d", (indColonne - 1), dateDebut) ' on évalue la date correspondant à la colonne cliquée
    
    h = Hour(HeureDebut) ' heures de début de la journée
    m = Minute(HeureDebut) ' minutes
    m = m + (h * 60) + TrancheHeure * (indLigne - 1) ' on détermine le nombre de minutes à ajouter
    
    dtCur = DateAdd("n", m, dtCur) ' on ajoute le nombre de minutes à la date correspondant à la colonne cliquée
    
    DateHeureTrancheHeure = dtCur ' on renvoie la date et l'heure obtenues
End Function

Private Sub InitPlanning()
    ' Initialise le Planning hebdomadaire avant sa mise à jour.
    ' Efface tous les rendez-vous, redimensionne les labels et remplit les en-têtes de colonnes avec les jours de la semaine choisie
    Dim i As Integer, j As Integer ' indice de ligne et de colonne
    Dim dtCur As Date ' variable qui parcourt les jours de la semaine
    
    With Forms!F_Planning!SF_Planning
    
        For i = 1 To nblignes ' on parcourt les indices des lignes
        
            For j = 1 To 7 ' on parcourt les indices des colonnes
               
                If (.Form("lblTrancheHeure" & i & "_" & j).Caption <> "") Then
                    .Form("lblTrancheHeure" & i & "_" & j).Caption = ""
                End If
                
                If (i Mod 2) = 1 Then ' on alterne la couleur des lignes
                    If .Form("lblTrancheHeure" & i & "_" & j).BackColor <> -2147483624 Then
                        .Form("lblTrancheHeure" & i & "_" & j).BackColor = -2147483624 ' colorie le label en jaune clair
                    End If
                Else
                    If .Form("lblTrancheHeure" & i & "_" & j).BackColor <> vbWhite Then
                        .Form("lblTrancheHeure" & i & "_" & j).BackColor = vbWhite ' colorie le label en blanc
                    End If
                End If
                
                If .Form("lblTrancheHeure" & i & "_" & j).Height <> hauteurlignes Then
                    .Form("lblTrancheHeure" & i & "_" & j).Height = hauteurlignes ' on définit la hauteur des lignes
                End If
                .Form("lblTrancheHeure" & i & "_" & j).Tag = "" ' efface l'identifiant du rendez-vous si présent
            Next j
        
        Next i
        
        For j = 1 To 7 ' on parcourt les indices des colonnes du planning
        
            .Form("lblPostIt" & j).Caption = "" ' efface le contenu des étiquettes affichant les Post-it
            
            ' Copie la date du jour correspondant à l'indice de colonne
            dtCur = DateAdd("d", (j - 1), dateDebut)
            ' Affiche la date du jour correspondant à l'indice de colonne
            .Form("lblCol" & j).Caption = Format(dtCur, "Ddd dd mmm yyyy")
               
            If EstFerie(dtCur) Or EstWeekEnd(dtCur) Then ' si week-end ou jour férié
                'on colorie les en-têtes (rouge pour les week-ends)
                .Form("lblCol" & j).BackColor = 16761087
                ColorierColonne j, 16772351
            Else
                .Form("lblCol" & j).BackColor = 16761024
            End If
               
        Next j
       
    End With
End Sub

Public Sub MajPlanning()
    ' La procédure de mise à jour des rendez-vous sur le planning en fonction de la date de début de la semaine.
    ' La procédure sélectionne dans la table T_RendezVous les RDV compris entre la date de début et la date de début + 6 jours,
    ' puis met à jour le planning avec ces rendez-vous :
    ' Pour chaque RDV l'heure de début et de fin permettent de dimensionner le label correspondant à la 1re tranche du rendez-vous.
    Dim db As DAO.Database ' référence à la base
    Dim rsPL As DAO.Recordset ' variable recordset
    Dim idLigne As Long, idCol As Long ' indices de ligne et de colonne
    Dim stSQL As String ' variable contenant la chaîne SQL
    Dim nbTranches As Long
    Dim idColor As Long ' indice de la couleur
                  
                  
    ' Sélectionne les RDV compris entre DateDebut et DateDebut+7
    stSQL = "SELECT R_RendezVous.* " & _
    "FROM R_RendezVous " & _
    "WHERE (idEmploye= " & Nz(Forms!F_Planning!IdEmploye, 0) & ") and (R_RendezVous.DateHeureDebut < " & FormatDateUS(dateDebut + 7) & ") And (R_RendezVous.DateHeureFin >" & FormatDateUS(dateDebut) & ")"
    
    Set db = CurrentDb ' référence à la base courante
    Set rsPL = db.OpenRecordset(stSQL, dbOpenSnapshot) ' ouverture du recordset basé sur la requête R_RendezVous
                                                                                                                                                                                                      
    Forms!F_Planning!txtTitre.Caption = "PLANNING DU " & UCase(Format(dateDebut, "dd mmmm yyyy")) & " AU " & UCase(Format(dateDebut + 6, "dd mmmm yyyy"))
    Forms!F_Planning!txtDateDebut.Value = dateDebut
                                                                                                                                                                                                      
    ' initialise le planning
    InitPlanning
         
    MajPostIt ' mise à jour des Post-it
          
    Do While Not (rsPL.EOF) ' on parcourt les rendez-vous
    
        If Not IsNull(rsPL!CodeCouleur) Then ' si une couleur a été enregistrée
            idColor = rsPL!CodeCouleur ' définit la couleur du label
        Else ' sinon
            idColor = vbWhite ' la couleur est le blanc
        End If
        
        If DateDiff("d", rsPL!DateHeureDebut, rsPL!DateHeureFin) = 0 Then ' s'il s'agit d'un rendez-vous sur une journée
        
            idCol = IndiceColonne(rsPL!DateHeureDebut)
            idLigne = IndiceTrancheHeure(rsPL!DateHeureDebut)
            
            nbTranches = DateDiff("n", rsPL!DateHeureDebut, rsPL!DateHeureFin) \ TrancheHeure ' on détermine le nombre de lblTrancheHeurex horaires correspondants à la durée du rdv
            
            With Forms!F_Planning!SF_Planning.Form("lblTrancheHeure" & idLigne & "_" & idCol)
            
                .Height = hauteurlignes * nbTranches ' Hauteur du label = Hauteur de la idLigne multipliée par le nombre de tranches
            
                If Not IsNull(rsPL!IdEmploye) Then
                    .Caption = CentrerTexte(rsPL!Client, nbTranches) ' Centre le texte pour le nom du client
                Else
                    .Caption = CentrerTexte(Nz(rsPL!Memo, ""), nbTranches)
                End If
                
                ' copie l'identifiant du rendez-vous dans la propriété Tag, pour le récupérer ensuite lors du double-clic
                .Tag = rsPL!IdRendezVous
                .BackColor = idColor ' idColorie le label
                .FontBold = True ' Indique que l'étiquette affiche du texte en gras
                
            End With
              
        Else
            ' s'il s'agit d'un congé sur plusieurs jours
            MajCongé rsPL!DateHeureDebut, rsPL!DateHeureFin, rsPL!Memo, idColor
        End If
      
        rsPL.MoveNext
    
    Loop
    
    ' fermeture libération des variables
    rsPL.Close
    Set rsPL = Nothing
    
    Set db = Nothing
End Sub

Public Function OuvrirFormRendezVous(ByVal i As Integer, ByVal j As Integer)
    ' Ouvre le formulaire F_RendezVous sur double-clic d'un label du planning.
    ' Prend en arguments les indices de ligne et de colonne du label.
    Dim dtCur As Date ' variable pour date et de l'heure correspondant à la tranche d'indice i et j
    Dim dtDebut As Date ' Jour et Horaire de début.
    Dim dtFin As Date ' Jour et Horaire de fin.
    Dim IdRendezVous As Long ' Identifiant du rendez-vous
    
    dtCur = DateHeureTrancheHeure(i, j) ' copie dans la variable de la date et de l'heure correspondant à la tranche d'indice i et j
    ' s'il y a un RDV alors copier dans les variables dtDebut et dtFin
    ' les horaires de début et de fin du rdv.
    If Forms!F_Planning!SF_Planning.Form("lblTrancheHeure" & CStr(i) & "_" & CStr(j)).Tag <> "" Then
        IdRendezVous = Forms!F_Planning!SF_Planning.Form("lblTrancheHeure" & CStr(i) & "_" & CStr(j)).Tag
    End If

    ' ouvre le formulaire F_RendezVous
    DoCmd.OpenForm "F_RendezVous", , , "(IdRendezVous= " & IdRendezVous & ")"
    
    If Nz(Forms!F_RendezVous!txtDateHeureDebut, "") = "" Then ' si pas de rendez-vous saisi à cette période
        ' copies sur le formulaire F_RendezVous
        Forms!F_RendezVous!txtDateHeureDebut = dtCur ' copie la date et l'heure de début sur la zone de texte txtDateHeureDebut
        Forms!F_RendezVous!txtDateHeureFin = DateAdd("n", TrancheHeure * 2, dtCur)
        Forms!F_RendezVous!cmbEmploye = Forms!F_Planning!IdEmploye ' copie l'identifiant de l'employé gérant le planning
    End If
End Function