Créer une gestion de calendrier avec Access

Option Compare Database
Option Explicit


' Les fonctions du module.

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

Public Function FormatDuree(ByVal min As Integer) As String
    ' Convertit le nombre de minutes passé en argument
    ' dans un format du type "1 h 15"
    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 Function WeekEnd(laDate As Date) As Boolean
    ' Indique si la date passée en argument est sur un week-end
    WeekEnd = ((Weekday(laDate) = 1) Or (Weekday(laDate) = 7)) ' est un jour de la semaine (hors week-end)
End Function
Public Function DebutSemaine(ByVal dtSemaine As Date) As Date
    ' Prend en argument un jour dans la semaine et renvoie la date du premier jour de cette semaine.
    Dim i As Integer
    i = Weekday(dtSemaine, vbMonday)
    DebutSemaine = DateAdd("d", -i + 1, dtSemaine)
End Function

Public Function OuvrirFormSaisie(i As Integer)
    Dim dtJour As Date ' variable pour la date de la zone de texte au-dessus de la liste des rendez-vous
    Dim IdCalendrier As Long ' variable pour l'identifiant du rdv
    
    ' copie dans la variable la date affichée sur la zone de texte d'indice i
    dtJour = CDate(Forms("F_Calendrier")("zdtJourCalendrier" & i).Value)
    ' copie dans la variable l'identifiant du rendez-vous cliqué dans la zone de texte d'indice i
    IdCalendrier = Nz(Forms("F_Calendrier")("zdlJourCalendrier" & i).Value, 0)
                    
    ' ouvre le formulaire de saisie sur l'identifiant contenu dans la variable IdCalendrier
    DoCmd.OpenForm "F_Saisie", , , "(IdCalendrier= " & IdCalendrier & ")"
    
    ' met à jour la zone de texte zdtDateCalendrier avec la date contenue dans la variable
    Forms!F_Saisie!zdtDateCalendrier.Value = dtJour
    
    Forms!F_Saisie!CmbIdFiltre = Nz(Forms!F_Calendrier!CmdFiltreCalendrier, 0)
End Function

Public Function OuvrirFormAjout(ByVal j As Long)
    ' Ouvre le formulaire de saisie en mode ajout en double-cliquant sur un jour dans le calendrier
    ' prend en argument l'indice du jour correspondant sur le calendrier.
    Dim dtJour As Date ' variable pour copier la date du jour cliqué sur le calendrier.
        
    ' on copie dans la variable la date du jour correspondant à la zone de texte dans laquelle on a cliqué
    dtJour = CDate(Forms!F_Calendrier("zdtJourCalendrier" & j).Value)
             
    ' ouvre le formulaire de saisie en mode ajout
    DoCmd.OpenForm "F_Saisie", , , , acFormAdd
    
    ' met à jour la zone de texte zdtDateCalendrier avec la date contenue dans la variable
    Forms!F_Saisie!zdtDateCalendrier = dtJour
    
    Forms!F_Saisie!CmbIdFiltre = Nz(Forms!F_Calendrier!CmdFiltreCalendrier, 0)
End Function

Public Sub MajCalendrier()
    ' La procédure d'affichage des rendez-vous dans les zones de liste du calendrier en fonction du mois et de l'année choisis sur le calendrier
    ' Elle sélectionne, pour chaque zone de liste, les rendez-vous compris dans le mois choisi, puis les copie dans leur propriété Contenu.
    Dim i As Integer
    Dim dtJour As Date ' variable pour parcourir les jours du calendrier.
    Dim stSQL As String ' variable pour la chaîne contenant le code SQL
    Dim nbMois As Integer ' variable qui indique le mois.
    Dim nbAnnee As Integer ' variable qui indique l'année.
    Dim db As DAO.Database
    Dim rsCal As DAO.Recordset
    
    ' on copie dans une variable la date correspondant au 1er jour du calendrier
    dtJour = DebutSemaine(DateSerial(Forms!F_Calendrier!cmbAnnee, Forms!F_Calendrier!cmbMois, 1))
    
    ' On affiche le titre du calendrier pour le mois sélectionné
    Forms!F_Calendrier!lblTitre.Caption = "CALENDRIER DE " & UCase(Forms!F_Calendrier!cmbMois.Column(1)) & " " & Forms!F_Calendrier!cmbAnnee
    
    nbMois = Forms!F_Calendrier!cmbMois.Value ' copie du mois choisi sur le calendrier
    nbAnnee = Forms!F_Calendrier!cmbAnnee.Value ' copie de l'année choisie sur le calendrier
    
    ' on constitue le code sql.
    stSQL = "SELECT IdCalendrier, HeureDebut, HeureFin, " & _
                              "IIf(Not IsNull(T_Calendrier.[IdPersonne]),T_Personne.NomPersonne & ' ' & T_Personne.PrenomPersonne,'Autre') As Rdv, DateCalendrier " & _
            "FROM T_Calendrier LEFT JOIN T_Personne ON T_Calendrier.IdPersonne = T_Personne.NumPersonne " & _
            "WHERE (IdFiltre like '" & IIf(Forms!F_Calendrier!cmbFiltreCalendrier = 0, "*", Forms!F_Calendrier!cmbFiltreCalendrier) & "') and Month(T_Calendrier.DateCalendrier) = " & nbMois & " and Year(T_Calendrier.DateCalendrier) = " & nbAnnee & _
            " ORDER BY DateCalendrier, T_Calendrier.HeureDebut;"
       
    Set db = CurrentDb ' référence à la base courante
    
    Set rsCal = db.OpenRecordset(stSQL, dbOpenSnapshot) ' ouverture du recordset pour le code SQL généré
    
    For i = 1 To 42 ' 42 jours sur le Calendrier
        
        Forms!F_Calendrier("zdtJourCalendrier" & i).Value = dtJour ' Affiche les jours du Calendrier.

        If (WeekEnd(dtJour)) Or EstFerie(dtJour) Or EstConge(dtJour) Then
           Forms!F_Calendrier("zdlJourCalendrier" & i).BackColor = RGB(252, 219, 192) ' On colorie les zones de liste associées aux jours ouvrés.
        Else
           
           Forms!F_Calendrier("zdlJourCalendrier" & i).BackColor = -2147483624 ' On colorie les zones de liste associées aux jours fériés et week-end.
        End If
        
        If (nbMois = Month(dtJour)) And (nbAnnee = Year(dtJour)) Then ' Si dtJour est dans le mois en cours.
            Forms!F_Calendrier("zdtJourCalendrier" & i).Enabled = True ' On active les zones de texte associées aux jours.
            Forms!F_Calendrier("zdlJourCalendrier" & i).Enabled = True ' On active les zones de liste associées aux jours.    
        Else
            Forms!F_Calendrier("zdtJourCalendrier" & i).Enabled = False ' On désactive les zones de texte associées aux jours.
            Forms!F_Calendrier("zdlJourCalendrier" & i).Enabled = False ' On désactive les zones de liste associées aux jours.
        End If
        
        ' Copie dans la propriété RowSource de la zone de liste, les heures et les notes pour chaque rendez-vous du jour passé en argument
        RemplirListe rsCal, dtJour, Forms!F_Calendrier("zdlJourCalendrier" & i)
           
        dtJour = dtJour + 1 ' passe au jour suivant.
        
    Next i
    
    ' On ferme et libère les variables
    rsCal.Close
    Set rsCal = Nothing
    
    db.Close
    Set db = Nothing
End Sub