Réalisez un gestionnaire de modèles Word selon un jeu d'enregistrements

'**********************************************************************
' Project           : WordTemplateManager
' Module            : Form_frmTemplatesManager
' Type              : Document VBA
' DateTime          : 13/05/2014
' Author            : Jean-Philippe AMBROSINO
' Review            :
' Review date       :
' Purpose           : Module used to manage events and data from the form
'
'**********************************************************************
Option Compare Database
Option Explicit

Private Const CMD_SHOWLIST                             As String = "&Consulter la liste..."
Private Const CMD_VALIDATE_TEMPLATE                    As String = "&Valider ce modèle"
Private Const CMD_MODIFY_TEMPLATE                      As String = "&Modifier ce modèle"
Private Const CMD_RECLOSE                              As String = "&Refermer"
Private Const CMD_CLOSE                                As String = "&Fermer"
Private Const CMD_CANCEL                               As String = "&Annuler"

Private Const IS_AVAILABLE                             As String = "disponible"
Private Const IS_DEFINED                               As String = "affectée"
Private Const IS_SELECTED                              As String = "selectionnée"

Private Enum m_eSortBy
ByTown = 1
ByPostalCode = 2
End Enum

Private Enum m_eUsingMode
NotDefined = 0
UpdateTemplate = 1
ShowTemplateTowns = 2
CreateNewTemplate = 4
End Enum

Private m_blnIsNewTemplate                             As Boolean
Private m_strSelectedTemplate                          As String
Private m_intUsingMode                                 As m_eUsingMode

Private Sub Form_Load()
'Chargement du formulaire
'On rafraîchit alors l'affichage des contrôles
    ShowHideControls False
    'S'il n'existe aucun modèle...
    If TemplateIsDefined(True, 0) = False Then
        '...on affiche un message
        MsgBox "Aucun modèle n'a été défini pour un jeu de communes donné." & vbCrLf & "Le modèle par défaut pour les éditions des rapports sera utilisé.", vbInformation, "Examen des modèles"
        'et on désactive le bouton de consultation
        cmdList.Enabled = False
        'et on donne le focus au bouton Parcourir...
        With cmdOpenFile
            .Enabled = True
            .SetFocus
        End With
    Else
        'Sinon, le bouton de consultation est activé
        cmdList.Enabled = True
    End If
    'On met à jour la légende au bas de la liste avec aucune valeur
    Me.lblTownsSelected.Caption = ""
    'On force le groupe à filtrer sur les communes et on le désactive
    With Me.fraSortBy
        .Value = ByTown
        .Enabled = False
    End With
    'La variable de nouveau modèle est réinitialisée
    m_blnIsNewTemplate = False
End Sub

Private Sub cmdList_Click()
'Bouton Consulter/Modifier permettant d'afficher les modèles stockés ou de modifier un modèle
Dim oLboDefined                                        As ListBox
Dim oLboListToSet                                      As ListBox

Dim lngTemplateID                                      As Long
Dim SQLSelect                                          As String
Dim lngCountTowns                                      As Long
Dim I                                                  As Long
Dim J                                                  As Long
Dim T                                                  As Long
Dim lngaIDTown()                                       As Long
Dim lngIDTown                                          As Long

    'Vérifie la légende du bouton Liste/Modifier
    Select Case cmdList.Caption
        Case CMD_SHOWLIST
            'Si l'on est en mode consultation
            'On change la variable de module avec le flag correspondant
            m_intUsingMode = ShowTemplateTowns
            'On construit une clause SQL permettant de lister tous les modèles exceptés celui par défaut
            SQLSelect = "SELECT T.TemplateID, T.TemplateName "
            SQLSelect = SQLSelect & "FROM tblTemplatesAndTowns AS TT RIGHT JOIN tblOutputReportTemplates AS T ON TT.TemplateID = T.TemplateID "
            SQLSelect = SQLSelect & "GROUP BY T.TemplateID, T.TemplateName "
            SQLSelect = SQLSelect & "HAVING T.TemplateID > 1 "
            SQLSelect = SQLSelect & "ORDER BY T.TemplateID;"
            'On affecte le contrôle Listbox cible
            With Me.cboTemplateList
                .RowSource = SQLSelect
                .Value = vbNullString
            End With
            'On met à jour la légende au bas de la liste avec aucune valeur
            Me.lboTownsDefined.RowSource = vbNullString
            'On gère l'affichage des contrôles
            ShowHideControls True

        Case CMD_MODIFY_TEMPLATE
            'Si l'on est en mode modification
            'On change la variable de module avec le flag correspondant
            m_intUsingMode = UpdateTemplate
            'On récupère l'ID du modèle
            lngTemplateID = Nz(Me.cboTemplateList, 0)
            'S'il y a en a un, on établit la liste des communes selon le tri en cours
            If lngTemplateID Then
                If Me.fraSortBy = ByTown Then
                    SQLSelect = "SELECT C.IDTown, TownName & ' (' & PostalCode & ')' AS City "
                    SQLSelect = SQLSelect & "FROM tblTowns AS C "
                    SQLSelect = SQLSelect & "ORDER BY C.TownName;"
                Else
                    SQLSelect = "SELECT C.IDTown, PostalCode & ' (' & TownName & ')' AS CP "
                    SQLSelect = SQLSelect & "FROM tblTowns AS C "
                    SQLSelect = SQLSelect & "ORDER BY C.PostalCode;"
                End If
                'On affecte le contrôle ComboBox cible
                Me.lboTownToSet.RowSource = SQLSelect
                'On appose le nom du modèle sélectionné à la zone de texte
                Me.txtTemplateName = Me.cboTemplateList.Column(1)
                'On efface le tableau des communes
                Erase lngaIDTown()
                'On affecte les variables objet à chacune des Listbox
                Set oLboDefined = Me.lboTownsDefined
                Set oLboListToSet = Me.lboTownToSet
                'On compte le nombre d'éléments
                lngCountTowns = oLboDefined.ListCount
                'Pour chaque commune appartenant à la liste des communes affectées au modèle,
                'on alimente le tableau de type Long : lngaIDTown()
                For I = 0 To lngCountTowns - 1
                    ReDim Preserve lngaIDTown(0 To I)
                    lngaIDTown(I) = oLboDefined.ItemData(I)
                Next I
                'S'il y a des communes affectées (il peut ne pas y en avoir)
                If lngCountTowns Then
                    'Alors on compte le nombre de communes total
                    lngCountTowns = oLboListToSet.ListCount
                    'Et pour chacune de ces communes dans la liste des communes à définir
                    For I = 0 To lngCountTowns - 1
                        With oLboListToSet
                            'On récupère l'identifiant
                            lngIDTown = .ItemData(I)
                            'Et pour chaque élément du tableau (représentant chaque commune affectée au modèle)
                            For J = LBound(lngaIDTown) To UBound(lngaIDTown)
                                'Si elle correspond...
                                If lngaIDTown(J) = lngIDTown Then
                                    'Alors on la met en surbrillance
                                    .Selected(I) = True
                                    T = T + 1
                                End If
                            Next J
                        End With
                    Next I
                End If
                'On gère alors l'affichage des contrôles
                ShowHideControls False
                'On met à jour la légende au bas de la liste avec le nombre de communes sélectionnées
                RefreshNumberOfTowns oLboListToSet, IS_SELECTED, False, lngCountTowns
                'On change l'état activé du bouton d'effacement des communes selon le cas
                cmdClearSelection.Enabled = (T > 0)
            Else
                MsgBox "Veuillez sélectionner le modèle à modifier...", vbExclamation, "Aucun modèle"
            End If
    End Select
    'On libère les varibel objet
    Set oLboDefined = Nothing
    Set oLboListToSet = Nothing
End Sub

Private Sub cmdOpenFile_Click()
'Bouton [...] permettant de sélectionner un modèle Word
Const WORD_FILTER                                      As String = "Modèles Word 2007 (*.dotx)" & vbNullChar & "*.dotx" & vbNullChar & "Modèles Word 2007 avec macros (*.dotm)" & vbNullChar & "*.dotm" & vbNullChar & "Modèles Word 97-2003(*.dot)" & vbNullChar & "*.dot"
Dim strTemplateName                                    As String
Dim strTemplatePath                                    As String
Dim SQLSelect                                          As String

    On Error GoTo L_ErrcmdOpenFile_Click
    With Application
        'On appelle la fonction de sélection du fichier
        If OpenWordTemplateFile(Me.HWnd, .hWndAccessApp, "Sélection d'un modèle", .CurrentProject.Path, WORD_FILTER, strTemplateName) = False Then
            Err.Raise 18, "Sélection annulée", "Vous n'avez pas sélectionné de modèle à ajouter à votre liste."
        End If
    End With
    If Len(strTemplateName) = 0 Then
        'Si aucun fichier n'a été sélectionné
        MsgBox "Vous devez sélectionner un document Word pour enrichir la liste des correspondances Modèle/Communes.", vbExclamation, "Sélection non valide"
        Me.txtTemplateName = ""
    Else
        'Si un fichier a bien été sélectionné...
        'On récupère son chemin
        strTemplatePath = GetPathnameFromFullPath(strTemplateName, False)
        'On l'affecte au contrôle Label caché (pour le fun ; on aurait pu le mettre dans une variable)
        Me.lblTemplatePath.Caption = strTemplatePath
        'On affecte la zone de texte avec le nom du fichier
        Me.txtTemplateName = GetFilenameFromFullPath(strTemplateName)
        'On vérifie que le modèle n'a pas déjà été défini
        If IsTemplateAlreadyDefined(Me.txtTemplateName, Me.lblTemplatePath.Caption) Then
            'Si oui, alors on désélectionne tous les items
            UnselectAllItem lboTownToSet
            'On lève l'erreur
            err.Raise 3022, "Sélection incorrecte", "Le modèle '" & Me.txtTemplateName & "' que vous avez sélectionné a déjà été défini pour ce même dossier."
        Else
            'Sinon, selon l'option de tri...
            With Me.fraSortBy
                If .Value = ByTown Then
                    SQLSelect = "SELECT C.IDTown, TownName & ' (' & PostalCode & ')' AS Town "
                    SQLSelect = SQLSelect & "FROM tblTowns AS C "
                    SQLSelect = SQLSelect & "ORDER BY C.TownName;"
                Else
                    SQLSelect = "SELECT C.IDTown, PostalCode & ' (' & TownName & ')' AS CP "
                    SQLSelect = SQLSelect & "FROM tblTowns AS C "
                    SQLSelect = SQLSelect & "ORDER BY C.PostalCode;"
                End If
                .Enabled = True
            End With
            '... on rempli la liste avec toutes les communes
            Me.lboTownToSet.RowSource = SQLSelect
            'On met à jour la légende au bas de la liste avec le nombre de communes disponibles
            RefreshNumberOfTowns lboTownToSet, IS_AVAILABLE, False
            'Et on modifie la valeur des variables en spécifiant que l'on ajoute un nouveau modèle
            m_blnIsNewTemplate = True
            m_intUsingMode = CreateNewTemplate
        End If
    End If
    On Error GoTo 0
L_ExcmdOpenFile_Click:
    Exit Sub

L_ErrcmdOpenFile_Click:
    MsgBox Err.Description, 48, Err.Source
    Resume L_ExcmdOpenFile_Click
End Sub

Private Sub cmdClose_Click()
'Selon la légende du bouton Fermer
    Select Case cmdClose.Caption
        Case CMD_CLOSE
            'Si c'est Fermer, on ferme le formulaire
            DoCmd.Close acForm, Me.Name, acSaveYes
        Case CMD_RECLOSE
            'Si c'est Refermer, on gère l'affichage des contrôles
            ShowHideControls False
    End Select
End Sub

Private Sub cboTemplateList_AfterUpdate()
'Zone de liste modifiable des modèles Word

'Une fois le modèle sélectionné, on affiche les communes qui lui sont affectées
    RefreshTownList Me.cboTemplateList, False
    'On stocke l'ID du modèle dans un contrôle Label (pour le fun ; on aurait pu le mettre dans une variable)
    Me.lblTempletaID.Caption = Me.cboTemplateList
    'On change la légende du bouton Liste
    With cmdList
        .Caption = CMD_MODIFY_TEMPLATE
        .Enabled = True
    End With
    'On change l'état des boutons Valider et Supprimer
    cmdValidate.Enabled = False
    cmdRemoveTemplate.Enabled = True
    'Et celui du groupe d'options
    fraSortBy.Enabled = True
    'On vérifie que le modèle défini possède des communes
    If TemplateIsDefined(False, Me.cboTemplateList) = False Then
        Me.lblTownsSelected.Caption = "Aucune commune n'a été définie pour ce modèle"
    End If
End Sub

Private Sub cmdRemoveTemplate_Click()
'Bouton Supprimer autorisant la suppression d'un modèle
Dim oLboDefined                                        As ListBox
Dim SQLDelete                                          As String
Dim lngTemplateID                                      As Long

    On Error GoTo L_ErrcmdRemoveTemplate_Click
    'Message de confirmation
    If MsgBox("Voulez-vous supprimer le modèle '" & Me.cboTemplateList.Column(1) & "' de l'application  ?", vbQuestion + vbYesNo + vbDefaultButton2, "Supprimer le modèle") = vbYes Then
        'Si l'on confirme
        Set oLboDefined = Me.lboTownsDefined
        'On récupère l'ID du modèle
        lngTemplateID = Nz(Me.cboTemplateList, 0)
        'S'il y en a un (ComboBox non Null)
        If lngTemplateID Then
            'On supprime le modèle
            SQLDelete = "DELETE * FROM tblOutputReportTemplates WHERE TemplateID =" & lngTemplateID & ";"
            CurrentDb.Execute SQLDelete, dbFailOnError
            'Puis on supprime sa définition de communes
            SQLDelete = "DELETE * FROM tblTemplatesAndTowns WHERE TemplateID =" & lngTemplateID & ";"
            CurrentDb.Execute SQLDelete, dbFailOnError
        Else
            MsgBox "Veuillez sélectionner le modèle à supprimer...", vbExclamation, "Aucun modèle"
        End If
        'On rafraîchit la liste des modèles
        Me.cboTemplateList.Requery
        'La liste des communes est alors vide
        oLboDefined.RowSource = vbNullString
        'On met à jour la légende au bas de la liste avec aucune valeur
        Me.lblTownsSelected.Caption = vbNullString
        'On change l'état des boutons Consulter et Supprimer
        Me.cmdList.Enabled = False
        Me.cmdRemoveTemplate.Enabled = False
        'Et celui du groupe d'options
        Me.fraSortBy.Enabled = False
    End If

    On Error GoTo 0
L_ExcmdRemoveTemplate_Click:
    Exit Sub

L_ErrcmdRemoveTemplate_Click:
    MsgBox Err.Description, 48, Err.Source
    Resume L_ExcmdRemoveTemplate_Click
End Sub

Private Sub cmdValidate_Click()
'Bouton de validation du modèle
Dim oDB                                                As DAO.Database
Dim oRS                                                As DAO.Recordset
Dim oLboTownToSet                                      As ListBox
Dim lngTemplateID                                      As Long
Dim SQLSelect                                          As String
Dim SQLInsert                                          As String
Dim SQLDelete                                          As String
Dim lngCountTowns                                      As Long
Dim I                                                  As Long
Dim T                                                  As Long
Dim lngaIDTown()                                       As Long
Dim lngIDTown                                          As Long


    On Error GoTo L_ErrcmdValidate_Click
    'Sablier...
    DoCmd.Hourglass True
    'Si ce n'est pas un nouveau modèle, on affecte l'ID à la variable
    If Not m_blnIsNewTemplate Then
        lngTemplateID = Me.lblTempletaID.Caption
    End If
    'S'il n'y a pas d'ID et que ce n'est pas un nouveau modèle
    If lngTemplateID = 0 And m_blnIsNewTemplate = False Then
        'On lève une erreur
        err.Raise 17, "Aucun identifiant définissant le modèle n'a été défini..." & vbCrLf & vbCrLf & "Veuillez recommencer l'opération."
    End If
    'On vide le tableau et on instancie la BDD
    Erase lngaIDTown()
    Set oDB = CurrentDb
    'Si l'on est en mode Consultation...
    If m_intUsingMode = ShowTemplateTowns Then
        With oDB
            'On supprime toutes les communes du modèle (l'utilisateur à cliqué sur le bouton X)
            SQLDelete = "DELETE * FROM tblTemplatesAndTowns WHERE TemplateID = " & lngTemplateID & ";"
            .Execute SQLDelete, dbFailOnError
        End With
        'On prévient que le modèle n'a plus de commune et on propose d'en affecter d'autres...
        If MsgBox("Le modèle ne possède plus de communes associées." & vbCrLf & vbCrLf & "Voulez-vous lui affecter de nouvelles communes ?", vbQuestion + vbYesNo, "") = vbYes Then
            'On change le statut des variables
            m_blnIsNewTemplate = True
            m_intUsingMode = UpdateTemplate
            'Puis on rafraîchit la liste avec les communes selon les paramètres de la procédure
            RefreshTownList Me.cboTemplateList, True
        Else
            'On change le statut des variables à NonDefini
            m_intUsingMode = NotDefined
            'Et on modifie l'affichage des contrôles du formulaire
            ShowHideControls False
        End If
    Else
        'Si l'on est dans un autre mode que Consultation...
        'On affecte la variable de la liste des communes à affecter
        Set oLboTownToSet = Me.lboTownToSet
        'Compteur du tableau
        T = -1
        'On remplit le tableau avec les communes sélectionnées
        With oLboTownToSet
            lngCountTowns = .ListCount
            If lngCountTowns Then
                For I = 0 To lngCountTowns - 1
                    If .Selected(I) Then
                        T = T + 1
                        ReDim Preserve lngaIDTown(T)
                        lngaIDTown(T) = .ItemData(I)
                    End If
                Next I
                'Si aucune commune n'a été sélectionnée, on lève une erreur
                If T = 0 Then
                    Err.Raise 17, "Aucune commune sélectionnée", "Vous devez sélectionner les communes à affecter pour ce modèle !"
                End If
                'Sinon, on démarre l'ajout du modèle
                With oDB
                    If m_blnIsNewTemplate Then
                        'Si c'est un nouveau modèle... on l'ajoute et on récupère son ID
                        SQLSelect = "SELECT TemplateID, TemplateName, TemplatePath, IsUsed FROM tblOutputReportTemplates;"
                        Set oRS = .OpenRecordset(SQLSelect, 2)
                        With oRS
                            .AddNew
                            lngTemplateID = .Fields("TemplateID").Value
                            .Fields("TemplateName").Value = Me.txtTemplateName
                            .Fields("TemplatePath").Value = Me.lblTemplatePath.Caption
                            .Fields("IsUsed").Value = True
                            .Update
                            .Close
                        End With
                    Else
                        'Sinon, on efface d'abord les communes déjà affectées à ce modèle
                        If m_blnIsNewTemplate = False Then
                            SQLDelete = "DELETE * FROM tblTemplatesAndTowns WHERE TemplateID = " & lngTemplateID & ";"
                            .Execute SQLDelete, dbFailOnError
                        End If
                    End If
                    'Puis on les ajoute une par une selon les éléments du tableau
                    For I = 0 To T
                        SQLInsert = "INSERT INTO tblTemplatesAndTowns (TemplateID, IDTown) VALUES (" & lngTemplateID & "," & lngaIDTown(I) & ");"
                        .Execute SQLInsert, dbConsistent
                    Next
                End With
            Else
                'Si aucune commune n'existe pour ce modèle,on lève une erreur
                err.Raise 17, "Aucune commune affectée à ce modèle n'a été définie..." & vbCrLf & vbCrLf & "Veuillez sélectionner des communes."
            End If
        End With
        'On rafraîchit alors l'affichage des contrôles
        ShowHideControls False
        'On met à jour la légende au bas de la liste avec aucune valeur
        Me.lblTownsSelected.Caption = vbNullString
        'On change l'état du bouton d'effacement (des communes)
        Me.cmdClearSelection.Enabled = (T > 0)
        'On vide la zone de texte du nom du modèle
        Me.txtTemplateName.Value = vbNullString
        'On vide la liste
        Me.lboTownToSet.RowSource = vbNullString
        'On désactive les options de tri
        Me.fraSortBy.Enabled = False
        'On réinitialise la variable stipulant un nouveau modèle
        m_blnIsNewTemplate = False
    End If

    On Error GoTo 0
L_ExcmdValidate_Click:
    'Sablier en pointeur
    DoCmd.Hourglass False
    'Libération des objets
    Set oLboTownToSet = Nothing
    Exit Sub

L_ErrcmdValidate_Click:
    MsgBox Err.Description, vbExclamation, Err.Source
    Resume L_ExcmdValidate_Click
End Sub

Private Sub fraSortBy_AfterUpdate()
'Tri des éléments (ici communes)
	RefreshTownList Nz(Me.cboTemplateList, 0), False
End Sub

Private Sub lboTownToSet_AfterUpdate()
'Rafraîchissement des informations sur le nombre de communes définies et confirmation des nouvelles sélections
Dim lngCountTowns                                      As Long
Dim oLboListToSet                                      As ListBox
Dim lngItemSelected                                    As Long
Dim strItemSeleted                                     As String

    Set oLboListToSet = Me.lboTownToSet
    With oLboListToSet
        lngItemSelected = .ListIndex
        If .Selected(lngItemSelected) Then
            lngCountTowns = TownIsAlreadyAttached(.Column(0))
            strItemSeleted = .Column(1)
            If lngCountTowns Then
                If MsgBox("La commune " & strItemSeleted & " a déjà été définie pour " & PluralSingular("un autre modèle", lngCountTowns) & "." & vbCrLf & vbCrLf & "Voulez-vous toujours séléctionner cette commune ?", vbExclamation + vbYesNo, "Attention") = vbNo Then
                    .Selected(lngItemSelected) = False
                End If
            End If
        End If
        RefreshNumberOfTowns oLboListToSet, IS_DEFINED, True
        Set oLboListToSet = Nothing
    End With
End Sub

Private Sub cmdClearSelection_Click()
Dim strMessage                                         As String
Dim C                                                  As Long

    'Donne le focus à un champ invisible
    Me.txtVoid.SetFocus
    'Vérifie la légende du bouton Liste/Modifier
    Select Case cmdList.Caption
        Case CMD_SHOWLIST
            'Si l'on est en mode consultation
            strMessage = "Voulez-vous supprimer toutes les communes affectées au modèle" & vbCrLf & Me.cboTemplateList.Column(1) & vbCrLf & vbCrLf & "Vous devrez valider pour que cette action soit prise en compte."
            If MsgBox(strMessage, vbExclamation + vbYesNo + vbDefaultButton2, "Confirmez l'action") = vbYes Then
                'On désélectionne tous les éléments de la liste (ici les communes)
                For C = 0 To lboTownToSet.ListCount - 1
                    Me.lboTownToSet.Selected(C) = False
                Next
                'On met à jour la légende au bas de la liste
                RefreshNumberOfTowns lboTownToSet, IS_AVAILABLE, False
                'On désactive le bouton Valider
                Me.cmdValidate.Enabled = False
            End If
        Case CMD_MODIFY_TEMPLATE
            'Si l'on est en mode modification
            strMessage = "Voulez-vous effacer toutes les communes sélectionnées pour le modèle" & vbCrLf & Me.cboTemplateList.Column(1) & " ?"
            If MsgBox(strMessage, vbExclamation + vbYesNo + vbDefaultButton2, "Effacer la liste") = vbYes Then
                'On active le bouton Valider en lui donnant le focus
                With Me.cmdValidate
                    .Enabled = True
                    .SetFocus
                End With
                'On définit la propriété Contenu à NullString
                Me.lboTownsDefined.RowSource = vbNullString
                'On désactive les boutons Liste, Supprimer et le groupe d'options de tri.
                Me.cmdList.Enabled = False
                Me.cmdRemoveTemplate.Enabled = False
                Me.fraSortBy.Enabled = False
            End If
    End Select
End Sub

Private Function TemplateIsDefined(ByVal Init As Boolean, ByVal TemplateId As Long) As Boolean
'Fonction permettant de savoir si un modèle existe ou qu'il possède des communes

    If Init Then
        TemplateIsDefined = (DCount("TemplateID", "tblOutputReportTemplates") > 0)
    Else
        If TemplateId Then
            TemplateIsDefined = (DCount("TemplateID", "tblTemplatesAndTowns", "TemplateID=" & TemplateId) > 0)
        Else
            TemplateIsDefined = (DCount("TemplateID", "tblTemplatesAndTowns") > 0)
        End If
    End If
End Function

Private Function TownIsAlreadyAttached(ByVal TownId As Long) As Long
'Fonction permettant de savoir si une commune existe pour plusieurs modèles
    If TownId Then
        TownIsAlreadyAttached = DCount("TemplateID", "tblTemplatesAndTowns", "IDTown=" & TownId)
    End If
End Function

Private Sub ShowHideControls(ByVal ShowIt As Boolean)
'Procédure de rafraîchissement des contrôles
    Me.txtVoid.SetFocus
    Me.shpTemplate.Visible = Not ShowIt
    Me.txtTemplateName.Visible = Not ShowIt
    Me.cmdOpenFile.Visible = Not ShowIt
    Me.shpTowns.Visible = Not ShowIt
    Me.lboTownToSet.Visible = Not ShowIt

    Me.shpListOfTemplates.Visible = ShowIt
    Me.cboTemplateList.Visible = ShowIt
    Me.lboTownsDefined.Visible = ShowIt

    Me.cmdClearSelection.Visible = IIf(m_intUsingMode = NotDefined, ShowIt, Not ShowIt)

    Me.lblTownsSelected.Caption = vbNullString

    If ShowIt Then
        Me.lblWhatTodo.Caption = "Veuillez sélectionner le modèle Word pour connaître les communes associées :"
    Else
        Me.lblWhatTodo.Caption = "Veuillez sélectionner un modèle Word (*.dot) puis ses communes associées :"
    End If

    With cmdList
        .Caption = IIf(ShowIt, CMD_MODIFY_TEMPLATE, CMD_SHOWLIST)
        .Enabled = Not ShowIt
    End With
    Me.fraSortBy.Enabled = IIf(m_intUsingMode = UpdateTemplate, True, ShowIt)
    cmdRemoveTemplate.Enabled = False
    cmdValidate.Enabled = False
    cmdClose.Caption = IIf(ShowIt, CMD_RECLOSE, CMD_CLOSE)
End Sub

Private Sub RefreshNumberOfTowns(ByVal TargetList As ListBox, ByVal TownStatus As String, ByVal ShowList As Boolean, Optional ByVal TotalCount As Long)
'Procédure de rafraîchissement des contrôles selon la liste passée en paramètre et le statut en cours
Dim T                                                  As Long
Dim lngCount                                           As Long
    'On donne le focus à un contrôle non visible
    Me.txtVoid.SetFocus
    'On énumère les communes sélectionnées
    With TargetList
        For T = 0 To TargetList.ListCount - 1
            If .Selected(T) Then
                lngCount = lngCount + 1
            End If
        Next
    End With
    'Selon le nombre, le bouton Valider est activé ou non
    Me.cmdValidate.Enabled = (lngCount > 0)
    If lngCount = 0 Then
        lngCount = Me.lboTownsDefined.ListCount
    End If
    'On met à jour la légende au bas de la liste en accordant en genre et en nombre
    Me.lblTownsSelected.Caption = lngCount & PluralSingular("commune " & TownStatus, lngCount) & IIf(TotalCount, "sur" & TotalCount & PluralSingular(" est affectée ", TotalCount) & "à ce modèle", " pour ce modèle")
    'On affecte l'état du bouton de suppression des communes
    With Me.cmdClearSelection
        .Enabled = (lngCount > 0)
        .Visible = ShowList
    End With
End Sub

Private Sub RefreshTownList(ByVal TemplateId As Long, ByVal ResetListOfTowns As Boolean)
'Procédure dédiées à rafraîchir la liste des communes
Dim SQLSelect                                          As String
Dim SQLWhere                                           As String

    'S'il y a un ID et que l'on a pas effacé les communes
    If TemplateId <> 0 And ResetListOfTowns = False Then
        'On rempli la liste avec les communes du modèle selon le tri
        If Me.fraSortBy = ByTown Then
            SQLSelect = "SELECT C.IDTown, C.TownName & ' (' & C.PostalCode & ')' AS Town "
            SQLSelect = SQLSelect & "FROM tblTemplatesAndTowns AS TT LEFT JOIN tblTowns AS C ON TT.IDTown = C.IDTown "
            SQLSelect = SQLSelect & "WHERE TT.TemplateID=" & TemplateId & " "
            SQLSelect = SQLSelect & "GROUP BY C.IDTown, C.TownName & ' (' & C.PostalCode & ')', C.TownName "
            SQLSelect = SQLSelect & "ORDER BY C.TownName;"
        Else
            SQLSelect = "SELECT C.IDTown, C.PostalCode & ' (' & C.TownName & ')' AS CP "
            SQLSelect = SQLSelect & "FROM tblTemplatesAndTowns AS TT LEFT JOIN tblTowns AS C ON TT.IDTown = C.IDTown "
            SQLSelect = SQLSelect & "WHERE TT.TemplateID=" & TemplateId & " "
            SQLSelect = SQLSelect & "GROUP BY C.IDTown, C.PostalCode & ' (' & C.TownName & ')', C.PostalCode "
            SQLSelect = SQLSelect & "ORDER BY C.PostalCode;"
        End If
    Else
        'Sinon, on rempli avec toutes les communes selon le tri
        If Me.fraSortBy = ByTown Then
            SQLSelect = "SELECT IDTown, TownName & ' (' & PostalCode & ')' AS Town "
            SQLSelect = SQLSelect & "FROM tblTowns "
            SQLSelect = SQLSelect & "ORDER BY TownName;"
        Else
            SQLSelect = "SELECT IDTown, PostalCode & ' (' & TownName & ')' AS CP "
            SQLSelect = SQLSelect & "FROM tblTowns "
            SQLSelect = SQLSelect & "ORDER BY PostalCode;"
        End If
    End If
    'Si l'on est en mode consultation
    If m_intUsingMode = ShowTemplateTowns Then
        'On rempli la liste des communes déjà définies
        Me.lboTownsDefined.RowSource = SQLSelect
    Else
        'Sinon, on rempli la liste des communes à définir ou compléter
        Me.lboTownToSet.RowSource = SQLSelect
        'Si ce n'est pas un nouveau modèle...
        If Not m_blnIsNewTemplate Then
            '...alors, on rafraîchit l'affichage des contrôles
            ShowHideControls True
        End If
    End If
    'Et selon que ce sont des communes définies ou disponibles (à affecter), on change la légende au bas de la liste
    RefreshNumberOfTowns lboTownsDefined, IIf(m_blnIsNewTemplate, IS_AVAILABLE, IS_DEFINED), (m_intUsingMode = ShowTemplateTowns)
    'Le bouton de consultation est activé
    cmdList.Enabled = True
End Sub

Private Sub UnselectAllItem(ByRef TargetList As ListBox)
'Procédure dédiée à désélectionner tous les élements d'une liste
Dim I                                                  As Long
    With TargetList
        For I = 0 To TargetList.ListCount - 1
            .Selected(I) = False
        Next
    End With
    'On réinitialise les contrôles et les variables
    Me.txtTemplateName = vbNullString
    Me.lblTemplatePath.Caption = vbNullString
    Me.lblTempletaID.Caption = vbNullString
    m_intUsingMode = NotDefined
    m_blnIsNewTemplate = False
End Sub

'**********************************************************************
' Project           : WordTemplateManager
' Module            : basFunctions
' Type              : Module
' DateTime          : 13/05/2014
' Author            : Jean-Philippe AMBROSINO
' Review            :
' Review date       :
' Purpose           : Module used to provide special functions for application
'
'**********************************************************************
Option Compare Database
Option Explicit


Private Type m_tyOpenFileName
lStructSize                                            As Long
hwndOwner                                          As Long
hInstance                                          As Long
lpstrFilter                                        As String
lpstrCustomFilter                                  As String
nMaxCustFilter                                     As Long
nFilterIndex                                       As Long
lpstrFile                                          As String
nMaxFile                                           As Long
lpstrFileTitle                                     As String
nMaxFileTitle                                      As Long
lpstrInitialDir                                    As String
lpstrTitle                                         As String
Flags                                              As Long
nFileOffset                                        As Integer
nFileExtension                                     As Integer
lpstrDefExt                                        As String
lCustData                                          As Long
lpfnHook                                           As Long
lpTemplateName                                     As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As m_tyOpenFileName) As Long

Public Function OpenWordTemplateFile(ByVal HWnd As Long, ByVal HInst As Long, ByVal Title As String, ByVal InitialDir As String, ByVal Filter As String, ByRef SelectedFile As String) As Double
'---------------------------------------------------------------------------
' Function      : OpenWordTemplateFile
' DateTime      : 13/05/2014
' Author        : Jean-Philippe AMBROSINO
' Purpose       : This Function is used to select a file from the FileDdialogBox
'...........................................................................
' Parameters    : HWnd : Handle de la fenêtre appelante
'                 HInst : Handle de l'instance
'                 Title : Titre de la fenêtre
'                 InitialDir : Dossier de départ
'                 Filter : Filtre sur fichier de type
'                 SelectedFile : Fichier sélectionné

' Return Codes  : Double = Taille du fichier en octets
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim OFName                                             As m_tyOpenFileName
    With OFName
        .lStructSize = Len(OFName)
        .hwndOwner = HWnd
        .hInstance = HInst
        .lpstrFilter = Filter
        .lpstrFile = Space$(254)
        .nMaxFile = 255
        .lpstrFileTitle = Space$(254)
        .nMaxFileTitle = 255
        .lpstrInitialDir = InitialDir
        .lpstrTitle = Title
        .Flags = 0
        If GetOpenFileName(OFName) Then
            SelectedFile = Left$(.lpstrFile, InStrRev(.lpstrFile, vbNullChar) - 1)
            OpenWordTemplateFile = FileLen(SelectedFile)
        Else
            OpenWordTemplateFile = 0
        End If
    End With
End Function

Public Function AddDirSeparator(ByVal PathName As String, Optional ByVal Separator As String = "\") As String
'---------------------------------------------------------------------------
' Function      : AddDirSeparator
' DateTime      : 13/05/2014
' Author        : Jean-Philippe AMBROSINO
' Purpose       : This Function is used to add a path separator
'...........................................................................
' Parameters    : PathName : Chemin à formater
'                 Separator : Séparateur à apposer

' Return Codes  : String = Chemin formaté
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
    If Right$(PathName, 1) <> Separator Then
        AddDirSeparator = PathName & Separator
    Else
        AddDirSeparator = PathName
    End If
End Function

Public Function GetPathnameFromFullPath(ByVal PathName As String, KeepBackSlash As Boolean, Optional ByVal Separator As String = "\") As String
'---------------------------------------------------------------------------
' Function      : GetPathnameFromFullPath
' DateTime      : 13/05/2014
' Author        : Jean-Philippe AMBROSINO
' Purpose       : This Function is used to get the path from a full path
'...........................................................................
' Parameters    : PathName : Chemin à examiner
'                 KeepBackSlash : True si l'on conserve le séparateur de fin
'                 Separator : Séparateur à apposer

' Return Codes  : String = Chemin du fichier
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
    If InStr(1, PathName, Separator, 1) Then
        GetPathnameFromFullPath = Left$(PathName, InStrRev(PathName, Separator) - IIf(KeepBackSlash, 0, 1))
    End If
End Function

Public Function GetFilenameFromFullPath(ByVal PathName As String, Optional ByVal Separator As String = "\") As String
'---------------------------------------------------------------------------
' Function      : GetFilenameFromFullPath
' DateTime      : 13/05/2014
' Author        : Jean-Philippe AMBROSINO
' Purpose       : This Function is used to get the file from a full path according to separator value
'...........................................................................
' Parameters    : PathName : Chemin à examiner
'                 Separator : Séparateur à identifier

' Return Codes  : String = Nom du fichier
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
    If InStr(1, PathName, Separator, 1) Then
        GetFilenameFromFullPath = Mid$(PathName, InStrRev(PathName, Separator) + 1)
    End If
End Function

Public Function NotInList(ByRef F As Form, ByRef NewData As String, ByVal ItemSubject As String) As Long
'---------------------------------------------------------------------------
' Function      : NotInList
' DateTime      : 13/05/2014
' Author        : Jean-Philippe AMBROSINO
' Purpose       : This Function is used to show a message when a data is not belong to a Listbox
'...........................................................................
' Parameters    : F : Formulaire cible
'                 NewData : Nouvelle valeur
'                 ItemSubject : Sujet du champ concerné

' Return Codes  : Long = acDataErrContinue if Event is raised
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
    MsgBox ItemSubject & " '" & NewData & "' ne fait pas partie de la liste !", 48, "Choix incorrect"
    NotInList = acDataErrContinue
End Function

Public Function PluralSingular(ByVal TextToChange As String, ByVal CountData As Long, Optional ByVal CharBefore As Integer = 32, Optional ByVal CharAfter As Integer = 0) As String
'---------------------------------------------------------------------------
' Function      : PluralSingular
' DateTime      : 13/05/2014
' Author        : Jean-Philippe AMBROSINO
' Purpose       : This Function is used to change the plural or singular of a given sentence
'...........................................................................
' Parameters    : TextToChange : Texte à mettre au pluriel
'                 CountData : Caractère à insérer avant
'                 CharAfter : Caractère à insérer après

' Return Codes  : String = Valeur retournée
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Const SINGULAR_WORDS                                   As String = "le;la;du;dela;un;une;à;lequel;laquelle;ce;cet;cette;quelque;quel;quelle;a;été;est"
Const PLURAL_WORDS                                     As String = "les;les;des;des;des;des;aux;lesquels;lesquelles;ces;ces;ces;quelques;quels;quelles;ont;été;sont"
Dim straSingKeywords()                                 As String
Dim straPlurKeywords()                                 As String
Dim straSentence()                                     As String
Dim strNewWord                                         As String
Dim strCurrentWord                                     As String
Dim strSingKeyword                                     As String
Dim strNewSentence                                     As String
Dim blnKWfound                                         As Boolean
Dim I                                                  As Integer
Dim W                                                  As Integer

    If CountData > 1 Then
        TextToChange = Replace(TextToChange, " de la ", " dela ", , , 1)
        straSentence = Split(TextToChange, " ")
        straSingKeywords = Split(SINGULAR_WORDS, ";")
        straPlurKeywords = Split(PLURAL_WORDS, ";")
        For W = LBound(straSentence) To UBound(straSentence)
            strCurrentWord = straSentence(W)
            If Len(strCurrentWord) Then
                For I = LBound(straSingKeywords) To UBound(straSingKeywords)
                    strSingKeyword = straSingKeywords(I)
                    If StrComp(strCurrentWord, strSingKeyword, 0) = 0 Then
                        strNewWord = straPlurKeywords(I)
                        blnKWfound = True
                        Exit For
                    End If
                Next
                If blnKWfound Then
                    strNewSentence = strNewSentence & strNewWord & Chr(32)
                Else
                    strCurrentWord = strCurrentWord & "s "
                    strNewSentence = strNewSentence & strCurrentWord
                End If
            End If
            blnKWfound = False
        Next
    Else
        strNewSentence = TextToChange
    End If
    PluralSingular = IIf(CharBefore, Chr(CharBefore), "") & strNewSentence & IIf(CharAfter, Chr(CharAfter), "")
End Function

DoCmd.OpenForm "Nom du formulaire", acNormal, , , , acDialog