Création et manipulation d'un planning - Partie 1

Private Sub Form_Open(Cancel As Integer)
    ' Chargement des images
    btnFermerR.Picture = CurrentProject.Path & "\image\btnFermerR.jpg"
    btnFermerS.Picture = CurrentProject.Path & "\image\btnFermerS.jpg"
    btnFermerC.Picture = CurrentProject.Path & "\image\btnFermerC.jpg"
    btnNouveauR.Picture = CurrentProject.Path & "\image\btnNouveauR.jpg"
    btnNouveauS.Picture = CurrentProject.Path & "\image\btnNouveauS.jpg"
    btnNouveauC.Picture = CurrentProject.Path & "\image\btnNouveauC.jpg"
End Sub

Function BasculerBouton(CtlMasque As String, CtlAffiche As String)
' frmActif représente le formulaire en cours d'utilisation
    frmActif.Controls(CtlAffiche).Visible = True
    frmActif.Controls(CtlMasque).Visible = False
End Function

' Variable pour récupération du formulaire en cours d'utilisation pour animation des boutons
Public frmActif As Form

Private Sub btnFermerS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Appel de la routine de bascule des images
    Call BasculerBouton("btnFermerC", "btnFermerS")
    ' Ferme le formulaire en cours
    DoCmd.Close
End Sub

Private Sub EntêteFormulaire_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' intitialisation de la variable objet public frmActif
    Set frmActif = Me
    ' Initialisation de l'affichage des boutons
    btnFermerR.Visible = True
    btnFermerS.Visible = False
    btnFermerC.Visible = False
    btnNouveauR.Visible = True
    btnNouveauS.Visible = False
    btnNouveauC.Visible = False
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' Chargement des images
    btnFermerR.Picture = CurrentProject.Path & "\image\btnFermerR.jpg"
    btnFermerS.Picture = CurrentProject.Path & "\image\btnFermerS.jpg"
    btnFermerC.Picture = CurrentProject.Path & "\image\btnFermerC.jpg"
    btnNouveauR.Picture = CurrentProject.Path & "\image\btnNouveauR.jpg"
    btnNouveauS.Picture = CurrentProject.Path & "\image\btnNouveauS.jpg"
    btnNouveauC.Picture = CurrentProject.Path & "\image\btnNouveauC.jpg"
    ' Variable qui récupère le premier CodeSalleFormation
    intCodeSalle = 1
End Sub

Private Sub NomSalleFormation_Enter()
    ' Test pour connaître la position de notre focus : Nouvel Enregistrement ou Premier enregistrement du Formulaire ?
    If CodeSalleFormation = 0 Then
        'Incrémente le dernier n° de salle
        Me.CodeSalleFormation = DMax("CodeSalleFormation", "T_SalleFormation") + 1
    End If
End Sub

Private Sub btnNouveauS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Appel de la procédure de bascule des images
    Call BasculerBouton("btnNouveauC", "btnNouveauS")
    ' Réactive le type Recordset en dynamique
    Me.RecordsetType = 0
    ' Autorise l'entrée de nouvelles données
    Me.AllowAdditions = True
    'Positionne le curseur sur le nouvel enregistrement
    DoCmd.GoToRecord acDataForm, "F_SaisieSalles", acNewRec
    ' initialisation de la variable de contrôle de saisie d'un nouvel enregistrement
    intCodeSalle = 0
End Sub

Private Sub btnFermerS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim strSqlSupprNouvelEnregistrement As String

' Structure de la requête de suppression de l'enregistrement incomplet
strSqlSupprNouvelEnregistrement = "DELETE NomSalleFormation FROM T_SalleFormation WHERE NomSalleFormation Is Null"

    ' Appel de la routine de bascule des images
    Call BasculerBouton("btnFermerC", "btnFermerS")
    If intCodeSalle > 0 Then
        ' Fermeture du formulaire, aucune saisie n'est lancée
        DoCmd.Close
    Else
        ' Affiche la boite de dialogue d'alerte - un nouvel enregistrement est en cours
        intReponse = MsgBox("La saisie de ce champ est obligatoire" & vbCrLf & _
                     "Souhaitez-vous interrompre l'opération ?", vbQuestion + vbYesNo, cstDVP)
        ' Teste la réponse de l'utilisateur
        If intReponse = vbYes Then
            ' Désactivation des messages système
            DoCmd.SetWarnings False
            ' Sauvegarde l'enregistrement incomplet
            DoCmd.RunCommand acCmdSaveRecord
            'Supprime l'enregistrement incomplet
            DoCmd.RunSQL strSqlSupprNouvelEnregistrement
            ' Réactivation des messages système
            DoCmd.SetWarnings True
            ' Ferme le formulaire
            DoCmd.Close
        End If
    End If
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' Charge les images
    Me.btnFermerR.Picture = CurrentProject.Path & "\Image\btnFermerR.jpg"
    Me.btnFermerS.Picture = CurrentProject.Path & "\Image\btnFermerS.jpg"
    Me.btnFermerC.Picture = CurrentProject.Path & "\Image\btnFermerC.jpg"
End Sub

Private Sub EntêteFormulaire_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' récupère le formulaire en cours
    Set frmActif = Me
    btnFermerR.Visible = True
    btnFermerS.Visible = False
    btnFermerC.Visible = False
End Sub

SELECT T_FamilleProduit.CodeFamilleProduit, T_FamilleProduit.NomFamilleProduit
FROM T_FamilleProduit
ORDER BY [NomFamilleProduit];

Private Sub cboFamilleProduit_AfterUpdate()
    ' réactualise la liste des produits en fonction de la famille choisie
    Me.cboProduit.Requery
    ' Envoie le focus dans le contrôle cboProduit
    ' Objectif : Développer automatiquement le contrôle : cboProduit
    ' En conséquence, l'évènement "sur Entrée" du contrôle cboProduit sera donc géré.
    DoCmd.GoToControl "cboProduit"
End Sub

Private Sub cboFamilleProduit_NotInList(NewData As String, Response As Integer)
    ' Appel de la routine publique AjoutDansListe
    Call AjoutDansListe("T_FamilleProduit", "NomFamilleProduit", NewData)
    ' Rafraîchit la liste "cboFamilleProduit"
    Response = acDataErrAdded
End Sub

Public Sub AjoutDansListe(strTable As String, strChamp As String, NouvelleValeur As String)
    ' Désactivation des messages système
    DoCmd.SetWarnings False
    ' Exécution de la requête ajout afin d'inclure la nouvelle saisie dans la liste
    ' Code proposé par Maxence HUBICHE dans la F.A.Q ACCESS
    DoCmd.RunSQL "INSERT INTO " & strTable & "( " & strChamp & " ) SELECT """ & NouvelleValeur & """;"
    ' Réactivation des messages système
    DoCmd.SetWarnings True
End Sub

SELECT T_Produits.CodeProduit, T_Produits.NomProduit, T_Produits.CodeFamilleProduit
FROM T_Produits
WHERE T_Produits.CodeFamilleProduit=[Formulaires]![F_SaisieCatalogue]![cboFamilleProduit]
ORDER BY T_Produits.NomProduit;

Private Sub cboProduit_Enter()
    ' Ouvre la liste déroulante dès réception du focus
    cboProduit.Dropdown
End Sub

Private Sub cboProduit_NotInList(NewData As String, Response As Integer)
    'Déclaration des variables
    Dim rsProduits As DAO.Recordset
    Dim strSqlProduits As String
    Dim lngCodeCouleur As Long
    
    ' Inititialistion des variables
    strSqlProduits = "SELECT * FROM T_Produits"
    Set rsProduits = CurrentDb.OpenRecordset(strSqlProduits)
    
    ' avertissement à l'utilisateur
    MsgBox "La palette de couleurs va s'afficher afin d'affecter une couleur au nouveau produit." _
    & vcrlf & "Cette couleur sera reprise sur le planning.", vbInformation, cstDVP
    
    ' ******************************************************
    ' appel de la palette de couleurs - Utilisation d'une API
    ' Code proposé par Tofalu
    ' ******************************************************
    
' Définition pour relancer la définition d'une couleur
Relance:
    lngCodeCouleur = ShowColor(Me.hwnd)
    
    ' Contrôle que la couleur choisie ne correspond pas à la couleur weekend ou à la couleur par défaut
    If lngCodeCouleur = 8454143 Or lngCodeCouleur = 16777215 Then
        MsgBox "la couleur choisie est une couleur réservée pour l'application", vbInformation, cstDVP
        ' renvoie sur l'étiquette et réaffiche la boite de couleurs
        GoTo Relance
    End If

    ' ******************************************************
    With rsProduits
        ' ajout d'un enregistrement
        .AddNew
            ' renseignement des champs
                ' Ajoute le nouveau produit
                .Fields(1) = NewData
                ' Stocke la famille du produit
                .Fields(2) = cboFamilleProduit
                ' Stocke la nouvelle couleur
                .Fields(3) = lngCodeCouleur
        ' Mise à jour de la table
        .Update
    End With
    ' Mise à jour de la liste
    Response = acDataErrAdded
End Sub

Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias _
"ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Function ShowColor(Handle As Long) As Long
    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As Long
    Dim lReturn As Long
    Dim CustomColors
    'set the structure size
    cc.lStructSize = Len(cc)
    'Set the owner
    cc.hwndOwner = Handle
    'set the custom colors (converted to Unicode)
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    'no extra flags
    cc.flags = 0
    'Show the 'Select Color'-dialog
    If CHOOSECOLOR(cc) <> 0 Then
        ShowColor = cc.rgbResult
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
    Else
        ShowColor = -1
    End If
End Function

Private Sub Form_Open(Cancel As Integer)
    ' Récupération du formulaire actif
    Set frmActif = Me
    ' Chargement des images
    Me.btnFermerR.Picture = CurrentProject.Path & "\Image\btnFermerR.jpg"
    Me.btnFermerS.Picture = CurrentProject.Path & "\Image\btnFermerS.jpg"
    Me.btnFermerC.Picture = CurrentProject.Path & "\Image\btnFermerC.jpg"
    Me.btnNouveauR.Picture = CurrentProject.Path & "\image\btnNouveauR.jpg"
    Me.btnNouveauS.Picture = CurrentProject.Path & "\image\btnNouveauS.jpg"
    Me.btnNouveauC.Picture = CurrentProject.Path & "\image\btnNouveauC.jpg"
End Sub

Private Sub CodeProduitEnseigne_Exit(Cancel As Integer)
    'Si la liste est nulle, sortie de la procédure
    If IsNull(CodeProduitEnseigne.Column(2)) Then Exit Sub
    ' Contrôle de la sélection d'un produit
    If CDec(CodeProduitEnseigne.Column(2)) <> CDec(CodeFamilleProduit) Then
        ' message d'alerte
        MsgBox "Le Produit sélectionné ne correspond pas à la Famille de produits choisie ! " & vbCrLf & _
                    "Veuillez refaire votre choix", vbInformation, cstDVP
        'action sur la liste
        With CodeProduitEnseigne
            ' Efface le contenu de la saisie
            .Value = ""
            ' Ouvre la liste automatiquement
            .Dropdown
        End With
        ' annule l'évènement "Sortie du contrôle"
        Cancel = True
    End If
End Sub

Private Sub btnNouveauS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Ajout d'un nouvel enregistrement
    DoCmd.GoToRecord , , acNewRec
    ' Appel de la routine de bascule des boutons
    Call BasculerBouton("btnNouveauC", "btnNouveauS")
End Sub

Private Sub btnFermerS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Test de fermeture du formulaire
    If MsgBox("Voulez-vous valider les modifications ?", vbQuestion + vbYesNo, cstDVP) = vbYes Then
        DoCmd.Close
    Else
        ' Annule la saisie
        Me.Undo
        ' ferme le formulaire
        DoCmd.Close
    End If
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' Mise en place animation bouton
    Set frmActif = Me
    ' initialisation des images
    btnDroiteR.Picture = CurrentProject.Path & "\image\btnDroiteR.jpg"
    btnDroiteS.Picture = CurrentProject.Path & "\image\btnDroiteS.jpg"
    btnDroiteC.Picture = CurrentProject.Path & "\image\btnDroiteC.jpg"
    btnGaucheR.Picture = CurrentProject.Path & "\image\btnGaucheR.jpg"
    btnGaucheS.Picture = CurrentProject.Path & "\image\btnGaucheS.jpg"
    btnGaucheC.Picture = CurrentProject.Path & "\image\btnGaucheC.jpg"
    btnDateJourR.Picture = CurrentProject.Path & "\image\btnDateJourR.jpg"
    btnDateJourS.Picture = CurrentProject.Path & "\image\btnDateJourS.jpg"
    btnDateJourC.Picture = CurrentProject.Path & "\image\btnDateJourC.jpg"
    btnFormateurR.Picture = CurrentProject.Path & "\image\btnFormateurR.jpg"
    btnFormateurS.Picture = CurrentProject.Path & "\image\btnFormateurS.jpg"
    btnFormateurC.Picture = CurrentProject.Path & "\image\btnFormateurC.jpg"
    btnFermerR.Picture = CurrentProject.Path & "\image\btnFermerR.jpg"
    btnFermerS.Picture = CurrentProject.Path & "\image\btnFermerS.jpg"
    btnFermerC.Picture = CurrentProject.Path & "\image\btnFermerC.jpg"
    btnCatalogueR.Picture = CurrentProject.Path & "\image\btnCatalogueR.jpg"
    btnCatalogueS.Picture = CurrentProject.Path & "\image\btnCatalogueS.jpg"
    btnCatalogueC.Picture = CurrentProject.Path & "\image\btnCatalogueC.jpg"
    btnSalleR.Picture = CurrentProject.Path & "\image\btnSalleR.jpg"
    btnSalleS.Picture = CurrentProject.Path & "\image\btnSalleS.jpg"
    btnSalleC.Picture = CurrentProject.Path & "\image\btnSalleC.jpg"
    btnBasR.Picture = CurrentProject.Path & "\image\btnBasR.jpg"
    btnBasS.Picture = CurrentProject.Path & "\image\btnBasS.jpg"
    btnBasC.Picture = CurrentProject.Path & "\image\btnBasC.jpg"
    btnHautR.Picture = CurrentProject.Path & "\image\btnHautR.jpg"
    btnHautS.Picture = CurrentProject.Path & "\image\btnHautS.jpg"
    btnHautC.Picture = CurrentProject.Path & "\image\btnHautC.jpg"

' initialisation des variables
        ' Affecte la couleur par défaut de la première étiquette du planning
        ' Ainsi le dessin des étiquettes des dates commence toujours par la même couleur.
        lngCouleurfond = 10079487
        ' désactivation des repères
        optReperes = False
        ' Initialisation de la date
        varDateTraitee = CDate("24/03/08")
        ' affiche la date du jour sur le formulaire
        txtDateDebutPlanning = varDateTraitee
        ' vide la chaîne des salles concernées
        strSallesConcernees = ""
        ' Initialisation de la variable fin de jeu d'enregistrements (lecture des entêtes de lignes)
        boolEOF = False
        
        ' Initialisation du compteur d'enregistrements
        lngCompteurRecord = 0
        lngRecordDepart = 0
        intDefilementSalle = 0
        ' intitialisation des variables dates pour l'extraction des réservations
        varDateDebutPlanning = Format(varDateTraitee, "mm/dd/yy")
        varDateFinPlanning = Format(DateAdd("d", 31, varDateDebutPlanning), "mm/dd/yy")
        ' Affiche le formulaire en plein écran
        DoCmd.Maximize

        ' Initialisation de la date
        varDateTraitee = Date()

' Génération des étiquettes de salles
        Set rsSalles = CurrentDb.OpenRecordset(cstSalles)
        With rsSalles
            For intCompteur = 1 To 10
                Me.Controls("lblNomSalle" & intCompteur).Caption = .Fields(1)
                strSallesConcernees = strSallesConcernees & "," & Chr(34) & .Fields(1) & Chr(34)
                .MoveNext
            Next
        End With
        ' enlève la virgule en fin de chaîne
        strSallesConcernees = Right(strSallesConcernees, Len(strSallesConcernees) - 1)

    ' Dessin du planning
    GenerationPlanningSalles

Public Sub GenerationPlanningSalles()
    ' Déclaration de variables locales
    Dim intCompteurColonnes As Integer, intCompteurLignes, strInfoBulle As String, boolReservation As Boolean, boolEOFPlanning As Boolean
     ' intitialisation des variables
     boolReservation = False
     boolEOFPlanning = False
    ' Définition des limites du planning glissant (affichage sur 31 jours)
    varDateTraitee = varDateDebutPlanning
    varDateFinPlanning = DateAdd("d", 31, varDateDebutPlanning)

' Initialisation des étiquettes de date
    For intCompteur = 1 To 31
        ' Génère le contenu de l'étiquette (Propriété : Caption)
        Forms("F_Planning").Controls("lbljour" & intCompteur).Caption = Format(varDateTraitee, "ddd dd mmm")
        ' Changement couleur de l'étiquette
        If Day(varDateTraitee) = 1 Then
            If lngCouleurfond = 10079487 Then
                lngCouleurfond = 8454016
            Else
                lngCouleurfond = 10079487
            End If
        End If
       ' Colorise l'étiquette de date
        Forms("F_Planning").Controls("lbljour" & intCompteur).BackColor = lngCouleurfond
        ' Incrémentation de la date
        varDateTraitee = DateAdd("d", 1, varDateTraitee)
    Next

' *******************************************************************************
    '                            DESSIN DES ZONES RÉSERVÉES
    '********************************************************************************
       ' Initialisation de la requête
       strSqlWherePlanning = " Where NomSalleFormation IN(" & strSallesConcernees & _
                                ") AND DateStage BETWEEN #" & Format(varDateDebutPlanning, "mm/dd/yy") & _
                             "# AND #" & Format(varDateFinPlanning, "mm/dd/yy") & "# OR DateStage Is Null" _
                             & " ORDER BY T_SalleFormation.CodeSalleFormation, T_Planning.DateStage"
       Set rsPlanning = CurrentDb.OpenRecordset(cstPlanning & strSqlWherePlanning)
       ' Ouverture du jeu d'enregistrements
       With rsPlanning
            ' Récupère le nom de la salle réservée dans le premier enregistrement rsPlanning
            strNomSalleEnCours = .Fields(0)
            ' Début de la boucle de traitement des salles
            For intCompteurLignes = 0 To 9
                ' Début de la boucle de traitement des pavés du planning
               For intCompteurColonnes = 1 To 31
                    ' Incrémentation de la date -> Passe à la colonne suivante de la zone planning
                    varDateTraitee = DateAdd("d", intCompteurColonnes - 1, varDateDebutPlanning)
                    ' Test de contrôle de lecture de la table des données à afficher dans le planning
                    ' Si le test est vrai, il n'y a plus de réservation à noter dans la plage de date sélectionnée
                    ' On saute donc directement au dessin d'un carré blanc ou jaune (si varDateTraitee = date d'un weekend)
                    If boolEOFPlanning = True Then
                        ' Branchement à l'étiquette "Reprise"
                        ' Dessine que les plages blanches ou jaunes
                        GoTo Reprise
                    Else
                        ' Test pour la concordance entre la salle en cours de traitement et le nom de la salle concernée par une réservation.
                        ' Si différent, branchement à "Reprise" pour dessiner les pavés blancs ou jaunes
                        If .Fields(0) <> Forms("F_Planning").Controls("lblNomSalle" & intCompteurLignes + 1).Caption Then
                            GoTo Reprise
                        Else
                            ' Test de repérage de fin de fichier (lecture des données concernant les réservations
                            If .EOF Then
                                ' initialisation de la variable de fin de lecture des réservations
                                boolEOFPlanning = True
                            End If
                            ' Test de concordance entre la date réservée et la date traitée
                            If .Fields(1) = varDateTraitee Then
                            ' Préparation de l'info bulle
                            strInfoBulle = "Produit : " & .Fields(3) & vbCrLf & "Objet : " & .Fields(2) & vbCrLf & _
                                            "Journée en cours : " & .Fields("Quantieme") & IIf(.Fields("Quantieme") = 1, "er ", "ème ") _
                                            & vbCrLf & "Formateur : " & .Fields(4)
                                'Colore le pavé dans la couleur du produit (Réservation salle)
                                With Forms("F_Planning").Controls("lblindispo" & intCompteurLignes & intCompteurColonnes)
                                    .BackColor = rsPlanning.Fields(6)
                                    .ControlTipText = strInfoBulle
                                    .BorderColor = 10485760
                                End With
                                    ' Passe à l'enregistrement suivant
                                    .MoveNext
                                    strNomSallePrecedent = strNomSalleEnCours
                                    strNomSalleEnCours = .Fields(0)
                                    ' Initialisation de la variable qui indique qu'une réservation est en cours de traitement
                                    ' Permet de passer outre le traitement de la zone "Reprise"
                                    boolReservation = True
                            End If
Reprise:
                            If boolReservation = False Then
                            ' Recherche si la date en cours de traitement est un jour de weekend
                            If Weekday(varDateTraitee) = vbSaturday Or Weekday(varDateTraitee) = vbSunday Then
                                With Forms("F_Planning").Controls("lblindispo" & intCompteurLignes & intCompteurColonnes)
                                    ' affecte la couleur réservée au weekend
                                    .BackColor = 8454143
                                    ' Efface le contenu de l'info bulle du pavé du planning
                                    .ControlTipText = ""
                                    ' Réaffecte la couleur de bordure du pavé
                                    .BorderColor = 16737843
                                End With
                            Else
                                ' Ce n'est pas un jour de Weekend. Remise à blanc du pavé
                                With Forms("F_Planning").Controls("lblindispo" & intCompteurLignes & intCompteurColonnes)
                                    .BackColor = 16777215
                                    .ControlTipText = ""
                                    .BorderColor = 16737843
                                End With
                            ' Fin du test sur date traitée
                            End If
                            ' Fin test sur journée réservée
                            End If
                        End If
                    End If
                    ' Réinitialisation de la variable de réservation
                    boolReservation = False
                Next
            Next
       End With
End Sub

Private Sub Form_GotFocus()
    ' récupération du formulaire en cours d'utilisation (Gestion de l'animation des boutons)
    Set frmActif = Me
End Sub

Private Sub Détail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Récupération du formulaire actif
    Set frmActif = Me
    ' réinitialisation des images
    btnDroiteR.Visible = True
    btnDroiteS.Visible = False
    btnDroiteC.Visible = False
    btnGaucheR.Visible = True
    btnGaucheS.Visible = False
    btnGaucheC.Visible = False
    btnDateJourR.Visible = True
    btnDateJourS.Visible = False
    btnDateJourC.Visible = False
    btnFormateurR.Visible = True
    btnFormateurS.Visible = False
    btnFormateurC.Visible = False
    btnCatalogueR.Visible = True
    btnCatalogueS.Visible = False
    btnCatalogueC.Visible = False
    btnSalleR.Visible = True
    btnSalleS.Visible = False
    btnSalleC.Visible = False
    btnBasR.Visible = True
    btnBasS.Visible = False
    btnBasC.Visible = False
    btnHautR.Visible = True
    btnHautS.Visible = False
    btnHautC.Visible = False
    ' réinitialisation de la souris
    Screen.MousePointer = 0
End Sub

Private Sub Form_Open(Cancel As Integer)
    'Récupération des images
    Set frmActif = Me
    Me.btnFermerR.Picture = CurrentProject.Path & "\Image\btnFermerR.jpg"
    Me.btnFermerS.Picture = CurrentProject.Path & "\Image\btnFermerS.jpg"
    Me.btnFermerC.Picture = CurrentProject.Path & "\Image\btnFermerC.jpg"
    Me.objArdoise.Picture = CurrentProject.Path & "\Image\Ardoise.jpg"
    Me.btnValiderR.Picture = CurrentProject.Path & "\Image\btnValiderR.jpg"
    Me.btnValiderS.Picture = CurrentProject.Path & "\Image\btnValiderS.jpg"
    Me.btnValiderC.Picture = CurrentProject.Path & "\Image\btnValiderC.jpg"
    ' Initialise les champs indépendants avec les valeurs sélectionnées
    Me.txtSalleFormation = strSalle
    Me.txtDebutFormation = varDateCliquee
End Sub

Private Sub cboFamilleProduit_AfterUpdate()
    ' Mise à jour de la liste des produits disponibles dans la famille sélectionnée
    Me.cboProduits.Requery
    ' Renvoie le focus dans le contrôle "cboProduits"
    DoCmd.GoToControl "cboProduits"
End Sub

Private Sub cboProduits_AfterUpdate()
    ' Après sélection d'un produit, affiche tous les formateurs susceptibles d'assurer la formation.
    With Me.lstFormateur
        ' Précise le type de source de la liste
        .RowSourceType = "Table/Requête"
        ' Indique le nom de la source de la liste
        .RowSource = cstFormateursCompetents
        ' Rafraîchit la liste en fonction de la nouvelle source
        .Requery
    End With
End Sub

Private Sub Stage_Click()
    ' Déclaration des variables
    Dim rsIndisponibles As DAO.Recordset, rsDisponibles As DAO.Recordset
    Dim strDureeStage As String, strSqlWhere As String, strFormateursIndispo As String, strFormateursDispo As String
    Dim varDateDebutFormation, varDateFinFormation
    
    ' Initialisation de la variable de réservation
    boolReservationPossible = True
    
    ' Mise en forme de la chaîne strDureeStage pour respecter le pluriel ou le singulier
    If Me.DureeStage > 1 Then
        strDureeStage = Me.DureeStage & " jours"
    Else
        strDureeStage = Me.DureeStage & " jour"
    End If
    
    ' Récupération de l'intitulé du stage
    Forms!F_Reservation!txtFormationSelectionnee = Me.Stage & " - Durée : " & strDureeStage
    
    ' Récupération des bornes (dates entre lesquelles un ou plusieurs formateurs pourraient être occupés)
    varDateDebutFormation = varDateCliquee
    varDateFinFormation = DateAdd("d", DureeStage - 1, varDateDebutFormation)
    
    ' Mise à jour de la liste des formateurs disponibles pour le produit sélectionné
    ' Critères permettant de récupérer les formateurs occupés pendant la période de formation
    strSqlWhere = " WHERE  T_ProduitEnseigne.CodeProduitEnseigne = " & lngCodeProduit _
                          & " AND DateStage BETWEEN #" & Format(varDateDebutFormation, "mm/dd/yy")_
                          & "# AND #" & Format(varDateFinFormation, "mm/dd/yy") & "#"
                          
   
    ' Inititalisation du jeu d'enregistrements
    Set rsIndisponibles = CurrentDb.OpenRecordset(cstFormateursDispo & strSqlWhere)
    
    ' lecture du jeu résultat et création de la chaîne correspondant aux formateurs
    ' occupés afin de les exclure par l'opérateur NOT IN
    With rsIndisponibles
        Do While Not .EOF
            strFormateursIndispo = strFormateursIndispo & "," & .Fields(0)
            .MoveNext
        Loop
    End With
  
    ' Suppression de la virgule superflue en début de chaîne
    If strFormateursIndispo <> "" Then
        strFormateursIndispo = Right(strFormateursIndispo, Len(strFormateursIndispo) - 1)
        ' Reconstruction de la clause Where d'exclusion des formateurs indisponibles
        strFormateursDispo = cstFormateursCompetents & " WHERE T_ProduitEnseigne.CodeProduitEnseigne = " & _
                             lngCodeProduit & " AND T_Formateur.CodeFormateur NOT IN (" _
                             & strFormateursIndispo & ")"

' **************************************** Alimentation de lstFormateur par une liste de valeurs ***************
        ' Création de la liste de valeurs à afficher dans la liste lstFormateur
        Set rsDisponibles = CurrentDb.OpenRecordset(strFormateursDispo)
        
        ' Vérification qu'il existe bien des enregistrements dans le jeu résultat
        If rsDisponibles.RecordCount > 0 Then
            ' Réinitialisation de la variable pour réutilisation ci-dessous
            strFormateursDispo = ""
            
            ' boucle permettant de générer la liste de valeurs à afficher dans le contrôle "lstFormateur"
            With rsDisponibles
                Do While Not .EOF
                    strFormateursDispo = strFormateursDispo & ";" & .Fields(0) & ";" & .Fields(1)
                    .MoveNext
                Loop
             End With
            
            ' suppression de la virgule superflue en début de chaîne
            strFormateursDispo = Right(strFormateursDispo, Len(strFormateursDispo) - 1)
        End If
' ******************************************************************************************

    Else

' *************************** Alimentation de lstFormateur par une requête *****************
        ' initialisation de la variable avec affectation du nom d'une requête existante.
         strFormateursDispo = "R_FormateursProduitsEnseignes"
    End If
    ' Récupération des données à afficher
    With Forms!F_Reservation!lstFormateur
        If strFormateursIndispo = "" Then
            .ColumnCount = 4
            .ColumnWidths = "0;2800;0;0"
            .RowSourceType = "Table/Query"
            .RowSource = strFormateursDispo
        Else
            .ColumnCount = 2
            .ColumnWidths = "0;2800"
            .RowSourceType = "Value List"
            .RowSource = strFormateursDispo
        End If
    End With
    ' Appel de la fonction de validation de la réservation
    If ControleReservation(varDateCliquee, Me.DureeStage) = True Then
        lngCodeCatalogue = Me.CodeCatalogue
        intDureeStage = Me.DureeStage
        boolFermer = False
        Forms!F_Reservation!btnValiderS.Visible = True
    Else
        DoCmd.Close acForm, "F_Reservation"
    End If
End Sub

Private Sub btnFermerS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoCmd.Close
End Sub

Private Sub btnValiderS_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim strSqlAjoutReservation As String
    Dim varDateStage As Date
    ' Contrôle avant de lancer la réservation
    ' Vérifie si un formateur a été sélectionné
    If IsNull(lstFormateur) Then
        MsgBox "Choisir un formateur avant de valider !", vbInformation, cstDVP
        Exit Sub
    End If
    ' Contrôle d'existence d'un choix de titre de formation
    If lngCodeCatalogue = 0 Then
        MsgBox "Choisir une formation dans le catalogue avant de valider !", vbInformation, cstDVP
        Exit Sub
    End If

' Désactive les messages système
    DoCmd.SetWarnings False
    
    ' Ajout de la formation dans la table des stages
    strSqlAjoutReservation = "INSERT INTO T_Stages ( DateStageDebut, CodeSalleFormation, CodeCatalogue, CodeFormateur ) " _
    & "SELECT #" & Format(varDateCliquee, "mm/dd/yy") & "#," & lngCodeSalleFormation _
    & "," & lngCodeCatalogue & "," & lstFormateur
    
    ' Exécute la requête SQL d'ajout
    DoCmd.RunSQL (strSqlAjoutReservation)
    lngCodeStage = DMax("CodeStage", "T_Stages")
    
    ' Boucle de création des jours réservés
    For intCompteur = 0 To intDureeStage - 1
        varDateStage = DateAdd("d", intCompteur, varDateCliquee)
        strSqlAjoutReservation = "INSERT INTO T_Planning(CodeStage, DateStage, Quantieme) " & "SELECT " _
        & lngCodeStage & ", #" & Format(varDateStage, "mm/dd/yy") & "# ," & intCompteur + 1
        ' Exécute la requête SQL d'ajout
        DoCmd.RunSQL (strSqlAjoutReservation)
    Next
    ' Réactivation des messages système
    DoCmd.SetWarnings True
    ' fermeture du formulaire
    DoCmd.Close

    'Réactivation du dessin du planning
    GenerationPlanningSalles
End Sub