Listes multifonctions

Image non disponible

Cet article est un prolongement de l'article Formulaire de recherche multicritères qui va nous permettre de créer des filtres "façon Excel", c'est à dire combinant les tris et le choix de critères personnalisés ou sur une seule valeur. Cet article est destiné aux utilisateurs confirmés ayant une bonne connaissance du VBA.

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. INTRODUCTION

Cet article se propose de décomposer le code qui permettra l'utilisation des listes déroulantes comme dans les filtres automatiques d'Excel. En effet, celles-ci nous offrent la possibilité de trier (croissant ou décroissant), de filtrer sur une valeur proposée dans la liste ou encore de personnaliser notre règle de sélection en précisant plusieurs critères combinés avec les opérateurs logiques Et ou OU.
Il s'adresse à un public averti ayant de bonnes bases en programmation car même si une préparation des contenus des listes peut être utile à tout utilisateur, tout le traitement se fait en code.

II. LE CAHIER DES CHARGES

L'image ci-contre nous montre notre cahier des charges.
Notre formulaire nous donnera la possibilité de :
     1) Filtrer les données sur une valeur précise;
     2) Trier les données (croissant ou décroissant) en affichant le n° d'ordre de la clé et son sens;
     3) Créer un filtre personnalisé et afficher la séquence SQL correspondante;
     4) Supprimer les clés sans incidence sur le filtre en cours ou inversement;
     5) Afficher dans un sous-formulaire le résultat de la sélection et dans un compteur le nombre de fiches filtrées;
     6) Afficher la fiche d'un salarié en double cliquant sur son nom.

III. LES TABLES DE LA BASE DE DONNEES

La base de données est constituée de 7 tables

Tables Objet Clé Primaire Relation Avec (Clé étrangère) Table liée
T_Employes Liste le détail des employés de la Société CodeEmploye    
T_Agences Liste les agences du Groupe CodeAgence CodeAgence T_Employes
T_Diplomes Liste les diplômes des employés CodeDiplome CodeDiplome T_Employes
T_PosteOccupe Liste les différents postes de l'entreprise CodePosteOccupe CodePosteOccupe T_Employes
T_SituationFamille Liste les différentes situations de famille (Marié, Célibataire ...) CodeFamille CodeFamille T_Employes
T_Operateurs Liste les différents opérateurs utilisés dans les filtres (égal, différent de ...) CodeOperateur    
T_ParamFiltres Liste les différentes mentions qui seront ajoutées dans les listes déroulantes (Tri croissant, Tri décroissant ...) CodeFiltre    


Image non disponible
Le modèle relationnel de la base de données utilisée


La base de données est disponible dans le chapitre TELECHARGEMENT

IV. LES FORMULAIRES

IV-A. Le formulaire principal

Voici, ci-contre le formulaire en mode création. J'ai numéroté les éléments qui seront implantés de 1 à 8.
     1) Les listes déroulantes qui seront alimentées dynamiquement;
     2) La zone de texte qui recevra le n° hiérarchique de la clé;
     3) L'image qui permettra de repérer le sens du tri (croissant ou décroissant);
     4) Les zones de texte qui afficheront pour mémoire le filtre appliqué;
     5) Les boutons qui permettront de supprimer les tris ou les filtres (voire les deux);
     6) Le sous-formulaire qui affiche le résultat du filtre;
     7) La zone de liste qui affiche les noms des fiches disponibles;
     8) Une zone de texte qui rappelle le nombre de fiches filtrées.

IV-A-1. Les listes déroulantes

Les quatre listes seront indépendantes et alimentées dynamiquement. Nous ne leur attribuons pas de source.
A noter ci-contre les différentes propriétés à modifier :
     - Le nom du contrôle correspond au nom du champ préfixé de "cbo" correspondant à l'appellation "combobox".
- (Voir l'article sur les conventions typographiques de Argyronet)
     - L'origine source : Table/Requête.
     - Le contenu reste vierge. En effet, la requête sera implantée via le code VBA.

IV-A-2. Les zones de texte pour l'affichage de la hiérarchie des clés

Pour chaque liste, on fera correspondre une zone de texte qui sera nommée : txtNumCle suivi d'un index (1 à 4). Cet index correspondra, lors de la programmation, au numéro de la liste sur laquelle l'utilisateur intervient.

IV-A-3. Les images du sens de tri

J'ai recherché sur le net deux images de flêches qui seront parfaitement superposées. Celles-ci s'afficheront ou se masqueront en fonction du sens du tri choisi. Comme pour les zones de texte, je les ai nommées : imgDesc et imgAsc suivi du même index que précédemment (1 à 4).

IV-A-4. Les zones de texte affichant le filtre de sélection

Il nous faut maintenant quatre zones de texte pour recevoir la syntaxe du filtre résultant des différents critères posés.
Ces zones sont nommées : txtSql toujours suivies du même système d'indexation (1 à 4).

IV-A-5. Les boutons d'effacement

Comme il est précisé dans le cahier des charges :
     - Effacer toutes les clés : efface la règle de tri sans affecter les filtres en cours.
- Nom du bouton : btnEffacerClesTri
     - Effacer tous les filtres : Réaffiche toutes les données tout en préservant les tris en cours.
- Nom du bouton : btnEffacerFiltre
     - Effacer tout : Efface tris et filtres posés.
- Nom du bouton : btnEffacerTout

IV-A-6. Le sous-formulaire résultat

Il s'agira d'un formulaire en mode continu dont la source dépend des choix faits dans les différentes listes déroulantes. On disposera encore pour cet objet d'une requête dynamique. On remarquera sur l'image que, dans le pied de formulaire, j'ai implanté un champ de cumul qui permettra d'alimenter le compteur de fiches (n° 8 sur l'image). Cet élément sera nommé : txtNbSalariesSF

IV-A-7. La liste des Noms sélectionnés

Il s'agit là d'une zone de liste qui comme pour les autres objets dépend des choix de l'utilisateur.
On trouvera ci-contre les principales propriétés à paramétrer.
Nommez cette liste : lstEmploye

IV-A-8. Le compteur de fiches

On déposera sur le formulaire une zone de texte indépendante à nommer : txtNbSalaries.
La source de ce contrôle récupère le contenu du champ calculé du pied du sous-formulaire.
Ce qui nous donne l'expression :

=VraiFaux(SF_ResultatFiltre.Formulaire!txtNbPersonnelSF <= 1;SF_ResultatFiltre.Formulaire!txtNbPersonnelSF & " Fiche";SF_ResultatFiltre.Formulaire!txtNbPersonnelSF & " Fiches")

IV-B. Le formulaire de personnalisation des critères

Image non disponible Image non disponible

Dans ce formulaire on retrouve la même structure que dans Excel lors de l'appel du filtre automatique personnalisé. (Qui a dit que j'avais copié ?...)

IV-B-1. La zone de texte : intitulé du champ

Il s'agit en fait d'une zone texte indépendante dans laquelle on retrouve l'intitulé du champ sur lequel l'utilisateur souhaite générer un filtre personnalisé.
Le contenu, récupéré à partir du nom de la liste utilisée dans le formulaire principal, sera implanté par VBA lors de l'ouverture du formulaire

IV-B-2. Les listes déroulantes "opérateurs de comparaison"

Les deux listes sont paramétrées comme ci-contre.
Le nom associé à ces deux objets : cboOperateur suivi d'un index 1 ou 2

IV-B-3. Les listes déroulantes "Valeur de critères"

Les deux listes sont paramétrées comme ci-contre.
Le nom associé à ces deux objets : cboCritere suivi d'un index 1 ou 2.
Le contenu sera implanté via VBA lors de l'ouverture du formulaire en fonction de la liste déroulante en cours d'utilisation dans le formulaire principal.

IV-B-4. Les opérateurs logiques

Il s'agit d'un groupe d'options classique n'ayant pas de valeur par défaut et dont le nom est : grpOperateurLogique

IV-B-5. Les messages d'information

Afin d'aider l'utilisateur dans le choix de l'opérateur à utiliser, j'ai placé deux étiquettes contenant les textes suivants :
     - Opérateur logique OU : Cela signifie qu'il suffit QU'UN SEUL DES CRITERES posés soit vérifié pour afficher l'enregistrement
     - Opérateur logique ET : Cela signifie qu'il faut que TOUS LES CRITERES posés soient vérifiés pour afficher l'enregistrement

Ces deux textes sont invisibles et leur visibilité est combinée via VBA avec le choix de l'opérateur.

IV-B-6. Les boutons

Rien de particulier sur le paramétrage des ces boutons. Ils déclencheront un process sur l'évènement : "sur clic".

IV-C. Le formulaire "Fiche du Personnel"

Cette fiche montre le détail des informations concernant un personnel. Il est bâti sur la requête : R_DetailEmploye.
Chacun pourra, à son goût, organiser ce formulaire.
Aucune procédure VBA n'est implantée dans celui-ci, hormis la procédure de fermeture.

V. LE CODE

Le code se répartit sur les différents objets en fonction de divers évènements.
Ainsi :
     - A l'ouverture du formulaire, il faut alimenter nos différentes listes;
     - Sur le choix d'une valeur dans une liste, il faut réactualiser les différents objets des formulaires ;
     - En double cliquant sur un nom de la zone de liste, il faut afficher la fiche idoine.

V-A. Le module DeclarationVariables


Pour alléger l'écriture des différentes requêtes, dans un module DeclarationVariables, j'ai stocké plusieurs constantes.
     - pour les différents SELECT et FROM qui seront nécessaires ;
     - pour la partie INNER JOIN qui est commune à toutes les requêtes.
On trouve ainsi :

 
Sélectionnez

' Source du sous-formulaire et de la zone de liste
Public Const cstSourceFiltre As String = "SELECT T_Employes.CodeEmploye, " _
                                   & "T_Employes.NomEmploye, " _
                                   & "T_Agences.Agence, " _
                                   & "T_SituationFamille.SItuationFamille, " _
                                   & "T_PosteOccupe.PosteOccupe, " _
                                   & "T_Diplomes.Diplome, " _
                                   & "T_Employes.SalaireActuel, " _
                                   & "T_Employes.SalaireDebut, " _
                                   & "T_Employes.Anciennete, " _
                                   & "IIf([Civilite]=""M"",""Masculin"",""Féminin"") AS Sexe, " _
                                   & "T_Employes.NbEnfants " _
                                   & "FROM T_SituationFamille INNER JOIN (T_PosteOccupe INNER JOIN " _
                                   & "(T_Agences INNER JOIN " _
                                   & "(T_Diplomes INNER JOIN " _
                                   & "T_Employes ON T_Diplomes.CodeDiplome = T_Employes.CodeDiplome) " _
                                   & "ON T_Agences.CodeAgence = T_Employes.CodeAgence) " _
                                   & "ON T_PosteOccupe.CodePosteOccupe = T_Employes.CodePosteOccupe) " _
                                   & "ON T_SituationFamille.CodeSituationFamille = T_Employes.CodeSituationFamille "
                                   

' Déclaration des constantes source des listes déroulantes du formulaire "F_ListesMultiFonctions"
Public Const cstSourceCboAgence As String = "SELECT CodeFiltre,LibelleFiltre FROM T_ParamFiltres ORDER BY CodeFiltre " _
                                        & "UNION SELECT DISTINCT (T_Agences.CodeAgence + 5) AS CodeFiltre, " _
                                        & "T_Agences.Agence FROM T_SituationFamille " _
                                                           
Public Const cstSourceCboDiplome As String = "SELECT CodeFiltre,LibelleFiltre FROM T_ParamFiltres ORDER BY CodeFiltre " _
                                        & "UNION SELECT DISTINCT (T_Diplomes.CodeDiplome + 5) AS CodeFiltre, " _
                                        & "T_Diplomes.Diplome FROM T_SituationFamille " _

Public Const cstSourceCboPosteOccupe As String = "SELECT CodeFiltre,LibelleFiltre FROM T_ParamFiltres ORDER BY CodeFiltre " _
                                        & "UNION SELECT DISTINCT (T_PosteOccupe.CodePosteOccupe + 5) AS CodeFiltre, " _
                                        & "T_PosteOccupe.PosteOccupe FROM T_SituationFamille " _

Public Const cstSourcecboSituationFamille As String = "SELECT CodeFiltre,LibelleFiltre FROM T_ParamFiltres ORDER BY CodeFiltre " _
                                        & "UNION SELECT DISTINCT (T_SituationFamille.CodeSituationFamille + 5) AS CodeFiltre, " _
                                        & "T_SituationFamille.SituationFamille FROM T_SituationFamille " _

' Déclaration de la constante pour les jointures (idem pour toutes les requêtes)
Public Const cstJointure As String = "INNER JOIN (T_PosteOccupe " _
                                    & "INNER JOIN (T_Agences " _
                                    & "INNER JOIN (T_Diplomes " _
                                    & "INNER JOIN T_Employes " _
                                    & "ON T_Diplomes.CodeDiplome = T_Employes.CodeDiplome) " _
                                    & "ON T_Agences.CodeAgence = T_Employes.CodeAgence) " _
                                    & "ON T_PosteOccupe.CodePosteOccupe = T_Employes.CodePosteOccupe) " _
                                    & "ON T_SituationFamille.CodeSituationFamille = T_Employes.CodeSituationFamille "


On remarquera que la source des listes déroulantes correspond à une requête UNION avec la table T_ParamFiltres et que, pour avoir une continuité dans les codes, j'ai ajouté 5 (nombre d'items de la 1ère table).
J'ai ensuite déclaré une autre série de variables publiques de travail car celles-ci interviennent à différents niveaux du Projet.

 
Sélectionnez

' Variables de gestion des clauses WHERE des différentes requêtes
Public p_strSqlWhere As String

' Variable de la gestion de la clause ORDER BY
' utilisée dans le formulaire "F_ListesMultiFonctions et dans le formulaire "F_Personnalise"
Public p_strSqlOrderBy As String

' Variables de gestion des clauses WHERE des listes déroulantes
' utilisées dans le formulaire "F_ListesMultiFonctions et dans le formulaire "F_Personnalise"
Public p_strSqlListe As String
Public p_strWhereListeAgence As String
Public p_strWhereListeDiplome As String
Public p_strWhereListePoste As String
Public p_strWhereListeFamille As String

' Variable tableau contenant la valeur de la liste précédant le nouveau choix
Public p_tabAnciennesValeursCombo() As Variant

' Variables de travail
Public p_intCompteur As Integer
Public p_bytValeurListe As Byte
Public p_monForm As Form

' Variables de gestion des filtres permet d'identifier la liste déroulante utilisée
' dans le formulaire "F_ListesMultiFonctions et dans le formulaire "F_Personnalise"
Public p_bytOrdreCbo As Byte


Enfin, j'ai déclaré une variable de type Utilisateur. Ce type de variable présente un intérêt incontestable. En effet, structurée comme un enregistrement avec ses noms de champs, elle nous évitera d'utiliser des tableaux dans lequels nous nous perdons avec la gestion des index (pour écrire dans les bonnes cellules !).

 
Sélectionnez

' Variable de type Utilisateur stockant les choix de critères
' du formulaire "F_Personnalise" ou des listes du formulaire "F_ListesMultiFonctions"
Public Type TCriteres
    NomChamp As String
    OpLogique As String
    CodeOp(1 To 2) As Byte
    Comparaison(1 To 2) As String
    ValCritere(1 To 2) As String
    Sql As String
    EtiquChamp As String
End Type

' affectation à la variable p_tabCriteres du type de variable utilisateur : T_Criteres
Public p_tabCriteres() As TCriteres

On remarquera que le type créé est affecté à un tableau dynamique. On verra plus loin dans l'article comment utiliser celui-ci. Pour matérialiser l'utilisation de notre tableau, on pourra penser à un tableau Excel avec ses entêtes de colonnes (éléments de la variable utilisateur) et ses n° de lignes

V-B. Le formulaire principal

V-B-1. La déclaration des variables

On retrouve ici les variables qui ne seront utilisées que dans ce module (Private). Comme pour le tableau des critères, on utilisera une variable de type Utilisateur pour suivre la gestion des clés de tris.

 
Sélectionnez

    ' Déclaration de variables de portée module
    Private m_bytOrdreCle As Byte
    Private m_ctlCombo As Control
    
    ' Déclaration du type utilisateur m_TCles
    Private Type m_TCles
        NomChampCle As String
        SensTri As String
        NumOrdreCle As Byte
    End Type
    
    Private m_tabCles() As m_TCles

V-B-2. L'initialisation du formulaire

La première procédure s'exécute donc à l'ouverture du formulaire.
Elle consiste à initialiser les différentes variables.
Dans un premier temps, on redimensionne tous les tableaux qui seront utilisés dans le projet

 
Sélectionnez

   ' Redimensionnement du tableau de 5 lignes (la valeur 0 ne sera pas utilisée)
    ' stocke les valeurs des listes. Chaque ligne correspond au  de la liste
    ReDim p_tabAnciennesValeursCombo(4)
    
    ' Redimensionnement du tableau de 5 lignes (les valeurs 0 ne seront pas utilisées)
    ReDim m_tabCles(4)
    
    ' Redimensionnement du tableau de 5 lignes (les valeurs 0 ne seront pas utilisées)
    ReDim p_tabCriteres(4)


Dans un second temps, au travers d'une boucle sur tous les objets, on initialise :
     - Les listes déroulantes sur la valeur "--- Tous ---" ;
     - On affecte cette même valeur sur toutes les lignes dans le tableau p_tabAnciennesValeursCombo ;
     - On affecte à chaque ligne du tableau p_tabCriteres, dans "la colonne" correspondante, le nom du champ et son étiquette

 
Sélectionnez

    ' Initialisation du tableau des critères de filtre et du tableau des anciennes valeurs des listes
        p_intCompteur = 1
        For Each m_ctlCombo In Controls
            If m_ctlCombo.ControlType = acComboBox Then
                ' Affichage de la mention " ---Tous--- dans chaque liste
                m_ctlCombo = 4
                ' Récupération du nom du champ
                p_tabCriteres(p_intCompteur).NomChamp = UCase(Right(m_ctlCombo.Name, Len(m_ctlCombo.Name) - 3))
                ' Récupération de la légende de l'étiquette
                p_tabCriteres(p_intCompteur).EtiquChamp = Me.Controls("lbl" & p_tabCriteres(p_intCompteur).NomChamp).Caption
                ' attribut la valeur correspondante à l'affichage de la mention " ---Tous--- "
                p_tabAnciennesValeursCombo(p_intCompteur) = 4
                ' incrémentation du compteur
                p_intCompteur = p_intCompteur + 1
            End If
        Next

On remarquera le principe d'affectation de la valeur dans la variable de type utilisateur :
tableau(index).ChampConcerne = valeur

exemple :
p_tabCriteres(p_intCompteur).NomChamp = UCase(Right(m_ctlCombo.Name, Len(m_ctlCombo.Name) - 3))


Enfin, on intitialise les différentes listes par appel de la routine : AlimentationDesListes()

 
Sélectionnez

    For Each m_ctlCombo In Controls
        If m_ctlCombo.ControlType = acComboBox Then
            Call AlimentationDesListes(m_ctlCombo.Name)
        End If
    Next


Ce qui nous donne, in extenso, la procédure suivante à l'ouverture du formulaire principal.

 
Sélectionnez

Private Sub Form_Open(Cancel As Integer)
    ' initialisation formulaire
    Set p_monForm = Forms("F_ListesMultiFonctions")
    
    ' Redimensionnement du tableau de 5 lignes (la valeur 0 ne sera pas utilisée)
    ' stocke les valeurs des listes. Chaque ligne correspond au  de la liste
    ReDim p_tabAnciennesValeursCombo(4)
    
    ' Redimensionnement du tableau de 5 lignes (les valeurs 0 ne seront pas utilisées)
    ReDim m_tabCles(4)
    
    ' Redimensionnement du tableau de 5 lignes (les valeurs 0 ne seront pas utilisées)
    ReDim p_tabCriteres(4) ' As Variant
    
    ' Initialisation du tableau des critères de filtre et du tableau des anciennes valeurs des listes
        p_intCompteur = 1
        For Each m_ctlCombo In Controls
            If m_ctlCombo.ControlType = acComboBox Then
                ' Affichage de la mention " ---Tous--- dans chaque liste
                m_ctlCombo = 4
                ' Récupération du nom du champ
                p_tabCriteres(p_intCompteur).NomChamp = UCase(Right(m_ctlCombo.Name, Len(m_ctlCombo.Name) - 3))
                ' Récupération de la légende de l'étiquette
                p_tabCriteres(p_intCompteur).EtiquChamp = Me.Controls("lbl" & p_tabCriteres(p_intCompteur).NomChamp).Caption
                ' attribut la valeur correspondante à l'affichage de la mention " ---Tous--- "
                p_tabAnciennesValeursCombo(p_intCompteur) = 4
                ' incrémentation du compteur
                p_intCompteur = p_intCompteur + 1
            End If
        Next
    
    ' Alimentation les listes du formulaire "F_ListesMultiFonctions"
    For Each m_ctlCombo In Controls
        If m_ctlCombo.ControlType = acComboBox Then
            Call AlimentationDesListes(m_ctlCombo.Name)
        End If
    Next

    ' Affectation des données à la zone de liste lstEmploye
    With Me.lstEmploye
        .RowSource = cstSourceFiltre
        .Requery
    End With

End Sub


Ci-dessous le détail de la procédure AlimentationDesListes. Le contenu correspond donc à la concaténation des différentes constantes et des variables p_strWhere... de chaque liste.

 
Sélectionnez

Sub AlimentationDesListes(strNomListe As String)
    ' Alimentation de la liste
    Select Case (strNomListe)
        Case Is = "cboAgence"
            p_monForm.Controls(strNomListe).RowSource = cstSourceCboAgence & cstJointure & p_strWhereListeAgence
        Case Is = "cboDiplome"
            p_monForm.Controls(strNomListe).RowSource = cstSourceCboDiplome & cstJointure & p_strWhereListeDiplome
        Case Is = "cboPosteOccupe"
            p_monForm.Controls(strNomListe).RowSource = cstSourceCboPosteOccupe & cstJointure & p_strWhereListePoste
        Case Is = "cboSituationFamille"
            p_monForm.Controls(strNomListe).RowSource = cstSourcecboSituationFamille & cstJointure & p_strWhereListeFamille
    End Select
    ' Réactualisation des listes
    p_monForm.Controls(strNomListe).Requery
End Sub

V-C. Les listes déroulantes

L'évènement pour chacune d'entre-elles sera bien évidemment : "sur après MAJ".
En fonction du choix on déclenchera soit :
     - un tri ;
     - un filtre simple ;
     - l'ouverture du formulaire de filtre personnalisé.

Découvrons la procédure ListesMultifonctions

 
Sélectionnez

Sub ListesMultifonctions()
        NumeroterListe
        ' Récupération de la valeur actuelle de la liste
        p_bytValeurListe = Me.ActiveControl
 
    Select Case p_bytValeurListe
        ' Cas Tri Croissant ou Tri décroissant
        Case Is = 1, 2
            ' Réaffichage de la valeur antérieure de la liste
            Me.Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
            AffichageOrdreCle
            GenererTri
        ' Cas d'effacement de la clé en cours et réorganisation des clés existantes
        Case Is = 3
            ' Réaffichage de la valeur antérieure de la liste
            Me.Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
            EffacerUneCle
            GenererTri
        ' Cas du réaffichage de la mention " ---Tous--- " dans la liste
        Case Is = 4
            Me.Controls("txtSql" & p_bytOrdreCbo).Visible = False
            EffacerFiltre
            DependanceListes
            GenererFiltre
        ' Cas correspondant au choix de la création d'un filtre multicritères sur un champ
        Case Is = 5
            DoCmd.OpenForm "F_Personnalise", acNormal, , , , , Me.ActiveControl.Name
        Case Else
        ' Cas correspondant au choix d'une valeur précise dans la liste
            FiltrerLesDonnees
            DependanceListes
            GenererFiltre
   End Select
    
	' Appel de la procédure de réactualisation des contrôles            
    ActualisationControle
    
End Sub


Dès le début de la procédure et avant le SELECT CASE, on trouve l'appel à la routine : NumeroterListe.
Son objectif est tout simplement de récupérer une valeur numérique qui pourra être réutilisée avec les contrôles indexés (txtNumCle, imgDesc, imgAsc) ou encore les listes cboCritere du formulaire F_Personnalise ou enfin du stockage des valeurs dans les tableaux (p_tabCriteres, p_tabAnciennesValeursCombo) .

 
Sélectionnez

Sub NumeroterListe()
    ' Affectation du  des listes
    With Me.ActiveControl
        Select Case True
            Case .Name = "cboAgence"
                p_bytOrdreCbo = 1
            Case .Name = "cboDiplome"
                p_bytOrdreCbo = 2
            Case .Name = "cboPosteOccupe"
                p_bytOrdreCbo = 3
            Case .Name = "cboSituationFamille"
                p_bytOrdreCbo = 4
        End Select
    End With
End Sub


Enfin, par l'instruction :
p_bytValeurListe = Me.ActiveControl
je récupère la valeur de la liste en cours d'utilisation pour lancer le traitement.

V-C-1. Choix 1 ou 2 : Tri croissant ou décroissant

 
Sélectionnez

        ' Cas Tri Croissant ou Tri décroissant
        Case Is = 1, 2
            ' Réaffichage de la valeur antérieure de la liste
            Me.Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
            AffichageOrdreCle
            GenererTri
            ...


On remarquera dans ce premier choix l'instruction qui réaffiche l'ancienne valeur en cas de filtre après avoir choisi l'option de tri.
Cette séquence se poursuit avec l'appel à deux routines :
     - AffichageOrdreClé : affiche un n° correspondant à la hiérarchie de la clé
- AffichageOrdreClé : affiche l'image "Ascendant" ou "Descendant".
     - GenererTri : Crée la syntaxe p_strSqlOrderBy en relisant le tableau m_tabCles

V-C-1-a. La procédure : AffichageOdreCle

 
Sélectionnez

Sub AffichageOrdreCle()
    With Me.Controls("txtNumCle" & p_bytOrdreCbo)
        ' Teste pour savoir si la liste a déjà été déterminée en tant que clé.
        ' En effet si le  d'ordre de la clé est visible, on ne traite qu'un changement de sens de tri
        If .Visible = False Then
            ' incrémentation du numéro d'ordre des clés
            m_bytOrdreCle = m_bytOrdreCle + 1
            ' Affiche la valeur dans le contrôle correspondant
            Me.Controls("txtNumCle" & p_bytOrdreCbo) = m_bytOrdreCle
            ' Rend le numéro d'ordre visible
            Me.Controls("txtNumCle" & p_bytOrdreCbo).Visible = True
            ' inscrit la clé dans le tableau des clés
            m_tabCles(m_bytOrdreCle).NomChampCle = p_tabCriteres(p_bytOrdreCbo).NomChamp
            m_tabCles(m_bytOrdreCle).NumOrdreCle = p_bytOrdreCbo
        End If
    End With
            ' inscrit le sens du tri
            If p_bytValeurListe = 1 Then
                ' Stockage du sens du tri
                m_tabCles(Me.Controls("txtNumCle" & p_bytOrdreCbo)).SensTri = " asc"
                ' Affiche le repère du sens de tri Ascendant
                Me.Controls("imgAsc" & p_bytOrdreCbo).Visible = True
                Me.Controls("imgDesc" & p_bytOrdreCbo).Visible = False
            ElseIf p_bytValeurListe = 2 Then
                m_tabCles(Me.Controls("txtNumCle" & p_bytOrdreCbo)).SensTri = " desc"
                ' Affiche le repère du sens de tri Descendant
                Me.Controls("imgAsc" & p_bytOrdreCbo).Visible = False
                Me.Controls("imgDesc" & p_bytOrdreCbo).Visible = True
            End If
End Sub

V-C-1-b. La procédure : GenererTri

 
Sélectionnez

Sub GenererTri()
    ' Teste l'existence d'une clé de tri
    If m_bytOrdreCle = 0 Then
        p_strSqlOrderBy = ""
    Else
        ' Initialise la variable
        p_strSqlOrderBy = " ORDER BY "
        ' relit le tableau pour générer la règle de tri
        For p_intCompteur = 1 To 4
                If m_tabCles(p_intCompteur).NomChampCle <> "" Then
                    If p_intCompteur = 1 Then
                        p_strSqlOrderBy = p_strSqlOrderBy & m_tabCles(p_intCompteur).NomChampCle & m_tabCles(p_intCompteur).SensTri
                    Else
                        p_strSqlOrderBy = p_strSqlOrderBy & ", " & m_tabCles(p_intCompteur).NomChampCle & m_tabCles(p_intCompteur).SensTri
                    End If
                Else
                    Exit For
                End If
        Next
    End If
End Sub

V-C-2. Choix 3 : Effacement d'une clé

 
Sélectionnez

        ' Cas d'effacement de la clé en cours et réorganisation des clés existantes
        Case Is = 3
            ' Réaffichage de la valeur antérieure de la liste
            Me.Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
            EffacerUneCle
            GenererTri


Dans cette séquence, nous ne reviendrons pas sur la routine GenererTri mais nous découvrirons le process : EffacerUneCle.
L'objet de cette procédure est de supprimer dans la table m_tabCles la valeur sélectionnée et de regrouper les clés.

 
Sélectionnez

Sub EffacerUneCle()
    Dim l_strNomCleEffacee As String
    
    If Me.Controls("txtNumCle" & p_bytOrdreCbo).Visible = True Then
        If m_bytOrdreCle > 0 Then
            ' Diminue le compteur de clé de 1
            m_bytOrdreCle = m_bytOrdreCle - 1
            ' Initialise la variable temporaire l_strNomCleEffacee
            l_strNomCleEffacee = p_tabCriteres(p_bytOrdreCbo).NomChamp
            
            ' Balayage de toute la table
            For p_intCompteur = 1 To 4
                If m_tabCles(p_intCompteur).NomChampCle = "" Then
                	' Sortie du balayage si la cellule est vide
                    Exit For
                Else
                    ' Test pour rechercher la ligne de tableau à effacer
                    If m_tabCles(p_intCompteur).NomChampCle = l_strNomCleEffacee Then
                        ' Effacement des repères de tri
                        If l_strNomCleEffacee = p_tabCriteres(p_bytOrdreCbo).NomChamp Then
                            Me.Controls("txtNumCle" & m_tabCles(p_intCompteur).NumOrdreCle).Visible = False
                            Me.Controls("imgAsc" & m_tabCles(p_intCompteur).NumOrdreCle).Visible = False
                            Me.Controls("imgDesc" & m_tabCles(p_intCompteur).NumOrdreCle).Visible = False
                        End If
                        ' Test pour voir si la clé à effacer est la dernière de la série
                        If p_intCompteur = 4 Then
                            m_tabCles(p_intCompteur).NomChampCle = ""
                        ElseIf m_tabCles(p_intCompteur + 1).NomChampCle = "" Then
                            m_tabCles(p_intCompteur).NomChampCle = ""
                        Else
                            ' Récupération des données de la clé suivante
                            m_tabCles(p_intCompteur).NomChampCle = m_tabCles(p_intCompteur + 1).NomChampCle
                            m_tabCles(p_intCompteur).SensTri = m_tabCles(p_intCompteur + 1).SensTri
                            m_tabCles(p_intCompteur).NumOrdreCle = m_tabCles(p_intCompteur + 1).NumOrdreCle
                            Me.Controls("txtNumCle" & m_tabCles(p_intCompteur).NumOrdreCle) = p_intCompteur
                            ' Récupération du nom de la clé pour continuer la boucle de recopie des lignes du tableau
                            l_strNomCleEffacee = m_tabCles(p_intCompteur + 1).NomChampCle
                        End If
                    End If
                End If
            Next
         End If
    End If
End Sub

V-C-3. Choix 4 : Choisir "--- Tous ---"

 
Sélectionnez

        ' Cas du réaffichage de la mention " ---Tous--- " dans la liste
        Case Is = 4
            Me.Controls("txtSql" & p_bytOrdreCbo).Visible = False
            EffacerFiltre
            DependanceListes
            GenererFiltre


Dans cette partie de la procédure, nous allons gérer le retour à la valeur "--- Tous ---" sur une liste.
Cette option entraine 4 étapes :
     - Masque la zone de texte affichant la règle de tri en cours ;
     - Supprime la règle de tri du tableau p_tabCriteres (procédure : EffacerFiltre) ;
     - Réactualise les listes déroulantes qui sont toutes dépendantes les unes des autres (procédure : ) ;
     - Régénère les filtres en fonction des critères toujours en cours (procédure : GenererFiltre).

V-C-3-a. Masque la zone de texte


Une seule instruction qui, en fonction du n° de la liste, masque la zone de texte correspondante :

 
Sélectionnez

Me.Controls("txtSql" & p_bytOrdreCbo).Visible = False

V-C-3-b. La procédure : EffacerFiltre

 
Sélectionnez

Sub EffacerFiltre()
    ' Récupère le  de position de la liste en cours d'utilisation
    NumeroterListe
    
    ' Efface les données correspondantes au filtre annulé
    Erase p_tabCriteres(p_bytOrdreCbo).CodeOp
    Erase p_tabCriteres(p_bytOrdreCbo).Comparaison
    p_tabCriteres(p_bytOrdreCbo).EtiquChamp = ""
    p_tabCriteres(p_bytOrdreCbo).OpLogique = ""
    p_tabCriteres(p_bytOrdreCbo).Sql = ""
    Erase p_tabCriteres(p_bytOrdreCbo).ValCritere

End Sub

V-C-3-c. La procédure : DependancesListes


Toutes les listes étant dépendantes les unes des autres, il nous faut à chaque fois régénérer la partie WHERE de la source de chaque liste.

 
Sélectionnez

Sub DependanceListes()
	' Réinitialisation des variables p_strWhere...
    p_strWhereListeAgence = ""
    p_strWhereListeDiplome = ""
    p_strWhereListePoste = ""
    p_strWhereListeFamille = ""

    ' Création des clauses WHERE pour les différentes listes
    ' Critères de dépendances de la Liste Agence
    If p_tabCriteres(1).Sql <> "" Then
        p_strWhereListeDiplome = "(" & p_tabCriteres(1).Sql & ")"
        p_strWhereListePoste = "(" & p_tabCriteres(1).Sql & ")"
        p_strWhereListeFamille = "(" & p_tabCriteres(1).Sql & ")"
    End If
    
    ' Critères de dépendances de la Liste Diplôme
    If p_tabCriteres(2).Sql <> "" Then
        p_strWhereListeAgence = "(" & p_tabCriteres(2).Sql & ")"
        If p_strWhereListePoste = "" Then
            p_strWhereListePoste = "(" & p_tabCriteres(2).Sql & ")"
        Else
            p_strWhereListePoste = p_strWhereListePoste & " AND (" & p_tabCriteres(2).Sql & ")"
        End If
        If p_strWhereListeFamille = "" Then
            p_strWhereListeFamille = "(" & p_tabCriteres(2).Sql & ")"
        Else
            p_strWhereListeFamille = p_strWhereListeFamille & " AND (" & p_tabCriteres(2).Sql & ")"
        End If
    End If
    
    ' Critères de dépendances de la Liste PosteOccupe
    If p_tabCriteres(3).Sql <> "" Then
        If p_strWhereListeAgence = "" Then
            p_strWhereListeAgence = "(" & p_tabCriteres(3).Sql & ")"
        Else
            p_strWhereListeAgence = p_strWhereListeAgence & " AND (" & p_tabCriteres(3).Sql & ")"
        End If
        If p_strWhereListeDiplome = "" Then
            p_strWhereListeDiplome = "(" & p_tabCriteres(3).Sql & ")"
        Else
            p_strWhereListeDiplome = p_strWhereListeDiplome & " AND (" & p_tabCriteres(3).Sql & ")"
        End If
        If p_strWhereListeFamille = "" Then
            p_strWhereListeFamille = "(" & p_tabCriteres(3).Sql & ")"
        Else
            p_strWhereListeFamille = p_strWhereListeFamille & " AND (" & p_tabCriteres(3).Sql & ")"
        End If
    End If
    
     ' Critères de dépendances de la Liste SituationFamille
     If p_tabCriteres(4).Sql <> "" Then
        If p_strWhereListeAgence = "" Then
            p_strWhereListeAgence = "(" & p_tabCriteres(4).Sql & ")"
        Else
            p_strWhereListeAgence = p_strWhereListeAgence & " AND (" & p_tabCriteres(4).Sql & ")"
        End If
        If p_strWhereListeDiplome = "" Then
            p_strWhereListeDiplome = "(" & p_tabCriteres(4).Sql & ")"
        Else
            p_strWhereListeDiplome = p_strWhereListeDiplome & " AND (" & p_tabCriteres(4).Sql & ")"
        End If
        If p_strWhereListePoste = "" Then
            p_strWhereListePoste = "(" & p_tabCriteres(4).Sql & ")"
        Else
            p_strWhereListePoste = p_strWhereListePoste & " AND (" & p_tabCriteres(4).Sql & ")"
        End If
    End If
    
    ' Ajout de WHERE
    If p_strWhereListeAgence <> "" Then
        p_strWhereListeAgence = " WHERE " & p_strWhereListeAgence
    End If
    If p_strWhereListeDiplome <> "" Then
        p_strWhereListeDiplome = " WHERE " & p_strWhereListeDiplome
    End If
    If p_strWhereListePoste <> "" Then
        p_strWhereListePoste = " WHERE " & p_strWhereListePoste
    End If
    If p_strWhereListeFamille <> "" Then
        p_strWhereListeFamille = " WHERE " & p_strWhereListeFamille
    End If
End Sub

V-C-3-d. La procédure : GenererFiltre

 
Sélectionnez

Public Sub GenererFiltre()
	' Inititalisation de la variable
    p_strSqlWhere = ""
    
    ' Balayage du tableau des critères
    For p_intCompteur = 1 To 4
        If p_tabCriteres(p_intCompteur).Sql <> "" Then
            If p_strSqlWhere = "" Then
                p_strSqlWhere = "(" & p_tabCriteres(p_intCompteur).Sql & ")"
            Else
                p_strSqlWhere = p_strSqlWhere & " AND " & p_tabCriteres(p_intCompteur).Sql
            End If
        End If
    Next
            
    ' Génération de la clause Where générale
   If p_strSqlWhere <> "" Then
        p_strSqlWhere = " WHERE " & p_strSqlWhere
    End If
End Sub

V-C-4. Choix 5 : Créer un filtre personnalisé


A ce niveau, nous allons ouvrir le formulaire F_Personnalise.

 
Sélectionnez

        ' Cas correspondant au choix de la création d'un filtre multicritères sur un champ
        Case Is = 5
            DoCmd.OpenForm "F_Personnalise", acNormal


On retrouvera alors une procédure d'initialisation propre à ce formulaire.

V-C-4-a. La procédure : Sur ouverture du formulaire F_Personnalise


Celle-ci se déroule en deux parties :
     - Initialisation des listes déroulantes ;
     - Récupération des données d'un filtre personnalisé existant.

V-C-4-a-i. Initialisation des listes
 
Sélectionnez

        With Me.Controls("cboCritere" & p_intCompteur)
            ' Affectation de la source en fonction du  de la liste
            Select Case p_bytOrdreCbo
                Case Is = 1
                    .RowSource = "SELECT Agence FROM T_Agences"
                Case Is = 2
                    .RowSource = "SELECT Diplome FROM T_Diplomes"
                Case Is = 3
                    .RowSource = "SELECT PosteOccupe FROM T_PosteOccupe"
                Case Is = 4
                    .RowSource = "SELECT SituationFamille FROM T_SituationFamille"
            End Select
            ' Actualisation des listes
            .Requery
        End With
V-C-4-a-ii. Récupération des données existantes
 
Sélectionnez

        ' Partie de la procédure permettant de réafficher les données d'un filtre personnalisé existant
        If Nz(p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur), 0) <> 0 Then
        
        Me.Controls("cboOperateur" & p_intCompteur) = p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur)
            Select Case p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur)
                ' Cas est égal, différent de ...
                Case Is = 2, 7
                    Me.Controls("cboCritere" & p_intCompteur) = p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)
                ' Case : Commence ...
                Case Is = 8, 9
                    Me.Controls("cboCritere" & p_intCompteur) = Right(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur), _
                                                                    Len(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)) - 1)
                ' Cas : se termine ...
                Case Is = 10, 11
                    Me.Controls("cboCritere" & p_intCompteur) = Left(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur), _
                                                                    Len(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)) - 1)
                ' Cas : Contient ...
                Case Else
                    Me.Controls("cboCritere" & p_intCompteur) = p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)
            End Select
        End If
V-C-4-a-iii. Procédure complète


Ces deux parties tournent dans une boucle de 2 passages.
On remarquera au début de cette procédure, l'initialisation des listes cboOperateur(n) sur 1, valeur correspondant à une ligne vierge.

 
Sélectionnez

Private Sub Form_Open(Cancel As Integer)
    ' Récupération de la légende de la liste concernée
    Me.txtChampCritere = p_tabCriteres(p_bytOrdreCbo).EtiquChamp
    Me.cboOperateur1 = 1
    Me.cboOperateur2 = 1
    
    ' Renseigne les valeurs des différentes listes
    For p_intCompteur = 1 To 2
        With Me.Controls("cboCritere" & p_intCompteur)
            ' Affectation de la source en fonction du  de la liste
            Select Case p_bytOrdreCbo
                Case Is = 1
                    .RowSource = "SELECT Agence FROM T_Agences"
                Case Is = 2
                    .RowSource = "SELECT Diplome FROM T_Diplomes"
                Case Is = 3
                    .RowSource = "SELECT PosteOccupe FROM T_PosteOccupe"
                Case Is = 4
                    .RowSource = "SELECT SituationFamille FROM T_SituationFamille"
            End Select
            ' Actualisation des listes
            .Requery
        End With
        
        ' Partie de la procédure permettant de réafficher les données d'un filtre personnalisé existant
        If Nz(p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur), 0) <> 0 Then
        
        Me.Controls("cboOperateur" & p_intCompteur) = p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur)
            Select Case p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur)
                ' Cas est égal, différent de ...
                Case Is = 2, 7
                    Me.Controls("cboCritere" & p_intCompteur) = p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)
                ' Case : Commence ...
                Case Is = 8, 9
                    Me.Controls("cboCritere" & p_intCompteur) = Right(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur), _
                                                                   Len(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)) - 1)
                ' Cas : se termine ...
                Case Is = 10, 11
                    Me.Controls("cboCritere" & p_intCompteur) = Left(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur), _
                                                                   Len(p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)) - 1)
                ' Cas : Contient ...
                Case Else
                    Me.Controls("cboCritere" & p_intCompteur) = p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)
            End Select
        End If
    Next
    
End Sub

V-C-4-b. Le bouton : Annuler


Cette petite procédure réaffecte la valeur qui était affichée avant d'entrer dans la boite de dialogue.

 
Sélectionnez

Private Sub btnAnnuler_Click()
	' Recherche la valeur affichée dans la liste avant d'entrer dans la boite de dialogue. 
    With Forms("F_ListesMultiFonctions")
        .Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
        .Requery
    End With
    DoCmd.Close
End Sub

V-C-4-c. Le bouton : Executer


Procédure principale du formulaire, va exécuter plusieurs travaux :
     - Contrôler l'existence du choix d'un opérateur logique ;
     - Contrôler l'existence du choix d'un critère ;
     - Décomposer le choix pour renseigner p_tabCriteres en fonction :
          1) du n° de la liste en cours d'analyse (voir p_intCompteur) ;
          2) de l'opérateur de comparaison ;
          3) de l'expression sélectionnée ou saisie dans la liste déroulante cboCritère.
     - Régénérer les filtres en conséquence.
     - Mettre les listes à jour ainsi que le sous-formulaire.

V-C-4-c-i. Contrôle de sélection d'un opérateur logique
 
Sélectionnez

        If p_intCompteur = 2 Then
            If Me.Controls("cboOperateur" & p_intCompteur) = 1 Then
                Exit For
            ElseIf Nz(Me.grpOperateurLogique, 0) = 0 Then
                MsgBox "Vous n'avez pas choisi d'opérateur logique (ET/OU)", vbInformation, "Développez.com - Listes MultiFonctions"
                With Me.grpOperateurLogique
                    .BorderWidth = 0
                    .BorderStyle = 1
                    .BorderColor = vbRed
                End With
                Exit Sub
            End If
        End If


Cette partie du process contrôle si l'utilisateur a sélectionné une seconde expression de comparaison. Si le test se révèle positif alors, j'affiche un message d'alerte et un cadre rouge apparaît autour du groupe d'options.

V-C-4-c-ii. Contrôle de l'existence d'une valeur critère
 
Sélectionnez

            If Me.Controls("cboCritere" & p_intCompteur) = "" Then
                MsgBox "Vous n'avez pas choisi de critère", vbInformation, "Développez.com - Listes MultiFonctions"
                DoCmd.GoToControl "cboCritere" & p_intCompteur
                Me.Controls("cboCritere" & p_intCompteur).Dropdown
                Exit Sub
            End If


Si une expression de comparaison a été sélectionnée et que la liste des valeurs critères est vide, j'affiche un message d'alerte.

V-C-4-c-iii. Remplissage du tableau p_tabCriteres
 
Sélectionnez

            If Me.Controls("cboOperateur" & p_intCompteur) > 1 Then
                ' CodeOperateur
                p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur) = Me.Controls("cboOperateur" & p_intCompteur)
                ' Expression de comparaison
                p_tabCriteres(p_bytOrdreCbo).Comparaison(p_intCompteur) = Me.Controls("cboOperateur" & p_intCompteur).Column(1)
                    ' récupération de la valeur du critère
                    Select Case Me.Controls("cboOperateur" & p_intCompteur)
                        Case 2 To 7
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = Me.Controls("cboCritere" & p_intCompteur)
                        Case Is = 8, 9
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = "'" & Me.Controls("cboCritere" & p_intCompteur)
                        Case Is = 10, 11
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = Me.Controls("cboCritere" & p_intCompteur) & "'"
                        Case Is = 12, 13
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = Me.Controls("cboCritere" & p_intCompteur)
                    End Select
            ' Fin Test contrôle de la valeur du CodeOperateur
            End If
        ' Fin du test d'existence d'un code opérateur
        End If


Cette opération a pour objet de reventiler dans les colonnes du tableau les différentes valeurs du formulaire.

V-C-4-c-iv. Création des syntaxes SQL
 
Sélectionnez

    For p_intCompteur = 1 To 2
        If Nz(p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur), 0) <> 0 Then
            Select Case p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur)
                 Case 2 To 7
                            p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " '" & _
                                                               p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) & "'"
                 Case Is = 8, 9 ' (Commence ou ne commence pas par ...)
                     p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " " & _
                                                               p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) & "*'"
                 Case Is = 10, 11 ' (Se termine par ou ne se termine pas par ...)
                     p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " " & _
                                                               "'*" & p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)
                 Case Is = 12, 13 ' (Contient ou ne contient pas ...)
                     p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " " & _
                                                               "'*" & p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) & "*'"
            End Select
        
            If Me.Controls("cboOperateur" & p_intCompteur) = 1 Or p_tabCriteres(p_bytOrdreCbo).OpLogique = "" _
               Or p_intCompteur = 2 Then
                Exit For
            Else
                ' Ajoute l'opérateur logique dans la syntaxe SQL
                p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & _
                IIf(Me.grpOperateurLogique = 1, " AND ", " OR ") & p_tabCriteres(p_bytOrdreCbo).NomChamp
            End If
        End If
    Next


Dans cette partie de la procédure, je m'attache à recréer la syntaxe SQL qui sera affichée dans la zone de texte située à droite de la liste déroulante dans le formulaire principal.

V-C-4-d-v. Génération des filtres et mise à jour des objets du formulaire
 
Sélectionnez

' Renseigne la bulle dans le formulaire principal
With Forms("F_ListesMultiFonctions").Controls("txtSql" & p_bytOrdreCbo)
    .Visible = True
    .Value = p_tabCriteres(p_bytOrdreCbo).Sql
End With

' Mise à jour des listes
' Création des séquences SQL pour chaque liste du formulaire principal
DependanceListes
' Réactualisation des listes
For p_intCompteur = 1 To 4
    AlimentationDesListes ("cbo" & p_tabCriteres(p_intCompteur).NomChamp)
Next

' Génération de la clause Where
GenererFiltre

' Affectation et Actualisation  du sous formulaire
With Forms.F_ListesMultiFonctions.SF_ResultatFiltre.Form
    .RecordSource = cstSourceFiltre & p_strSqlWhere & p_strSqlOrderBy
    .Requery
End With

' Affectation et Actualisation de la zone de liste lstEmploye
With Forms.F_ListesMultiFonctions.lstEmploye
    .RowSource = cstSourceFiltre & p_strSqlWhere & p_strSqlOrderBy
    .Requery
End With


Vous pouvez retrouver le détail de DependancesListes dans le chapitre V-C-3-c et GenererFiltre dans le chapitre V-C-3-d
Les autres instructions mettent à jour les zones de texte, le sous-formulaire SF_ResulatFiltre et la zone lstEmploye

V-C-4-c-vi. Procédure complète
 
Sélectionnez

Private Sub btnExecuter_Click()
Dim loc_NomListe As String
    
    For p_intCompteur = 1 To 2
    
        ' Test de contrôle du choix de l'opérateur logique
        If p_intCompteur = 2 Then
            If Me.Controls("cboOperateur" & p_intCompteur) = 1 Then
                Exit For
            ElseIf Nz(Me.grpOperateurLogique, 0) = 0 Then
                MsgBox "Vous n'avez pas choisi d'opérateur logique (ET / OU)", _
                       vbInformation, "Développez.com - Listes MultiFonctions"
                With Me.grpOperateurLogique
                    .BorderWidth = 0
                    .BorderStyle = 1
                    .BorderColor = vbRed
                End With
                Exit Sub
            End If
        End If
        
        ' Récupération des critères posés
        If Me.Controls("cboOperateur" & p_intCompteur) <> "" Then
            If Me.Controls("cboCritere" & p_intCompteur) = "" Then
                MsgBox "Vous n'avez pas choisi de critère", vbInformation, "Développez.com - Listes MultiFonctions"
                DoCmd.GoToControl "cboCritere" & p_intCompteur
                Me.Controls("cboCritere" & p_intCompteur).Dropdown
                Exit Sub
            End If
            If Me.Controls("cboOperateur" & p_intCompteur) > 1 Then
                ' CodeOperateur
                p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur) = Me.Controls("cboOperateur" & p_intCompteur)
                ' Expression de comparaison
                p_tabCriteres(p_bytOrdreCbo).Comparaison(p_intCompteur) = Me.Controls("cboOperateur" & p_intCompteur).Column(1)
                    ' récupération de la valeur du critère
                    Select Case Me.Controls("cboOperateur" & p_intCompteur)
                        Case 2 To 7
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = Me.Controls("cboCritere" & p_intCompteur)
                        Case Is = 8, 9
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = "'" & Me.Controls("cboCritere" & p_intCompteur)
                        Case Is = 10, 11
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = Me.Controls("cboCritere" & p_intCompteur) & "'"
                        Case Is = 12, 13
                            p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) = Me.Controls("cboCritere" & p_intCompteur)
                    End Select
            ' Fin Test contrôle de la valeur du CodeOperateur
            End If
        ' Fin du test d'existence d'un code opérateur
        End If
    Next
                 
            ' Test pour repérer si un critère a été posé dans la première ligne de la boite de dialogue
             ' sinon, le choix d'un opérateur logique est inutile
             If p_tabCriteres(p_bytOrdreCbo).CodeOp(2) > 0 Then
                ' Récupération de l'opérateur logique
                p_tabCriteres(p_bytOrdreCbo).OpLogique = Me.grpOperateurLogique
            End If
      
    ' Création de la syntaxe SQL
    p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).NomChamp
    
   ' Boucle de récupération des données du tableau
    For p_intCompteur = 1 To 2
        If Nz(p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur), 0) <> 0 Then
            Select Case p_tabCriteres(p_bytOrdreCbo).CodeOp(p_intCompteur)
                 Case 2 To 7
                            p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " '" & _
                                                               p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) & "'"
                 Case Is = 8, 9 ' (Commence ou ne commence pas par ...)
                     p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " " & _
                                                               p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) & "*'"
                 Case Is = 10, 11 ' (Se termine par ou ne se termine pas par ...)
                     p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " " & _
                                                               "'*" & p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur)
                 Case Is = 12, 13 ' (Contient ou ne contient pas ...)
                     p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & " " & _
                                                               Me.Controls("cboOperateur" & p_intCompteur).Column(2) & " " & _
                                                               "'*" & p_tabCriteres(p_bytOrdreCbo).ValCritere(p_intCompteur) & "*'"
            End Select
        
        If Me.Controls("cboOperateur" & p_intCompteur) = 1 Or _
                                            p_tabCriteres(p_bytOrdreCbo).OpLogique = "" Or p_intCompteur = 2 Then
            Exit For
        Else
            p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).Sql & _
                                               IIf(Me.grpOperateurLogique = 1, " AND ", " OR ") & _
                                               p_tabCriteres(p_bytOrdreCbo).NomChamp
        End If
    End If
Next

' Renseigne la bulle dans le formulaire principal
With Forms("F_ListesMultiFonctions").Controls("txtSql" & p_bytOrdreCbo)
    .Visible = True
    .Value = p_tabCriteres(p_bytOrdreCbo).Sql
End With

' Mise à jour des listes
' Création des sequences SQL pour chaque liste du formulaire principal
DependanceListes
' Réactualisation des listes
For p_intCompteur = 1 To 4
    AlimentationDesListes ("cbo" & p_tabCriteres(p_intCompteur).NomChamp)
Next

' Génération de la clause Where
GenererFiltre

' Affectation et Actualisation  du sous formulaire
With Forms.F_ListesMultiFonctions.SF_ResultatFiltre.Form
    .RecordSource = cstSourceFiltre & p_strSqlWhere & p_strSqlOrderBy
    .Requery
End With

' Affectation et Actualisation de la zone de liste lstEmploye
With Forms.F_ListesMultiFonctions.lstEmploye
    .RowSource = cstSourceFiltre & p_strSqlWhere & p_strSqlOrderBy
    .Requery
End With

' Fermeture du formulaire
DoCmd.Close acForm, "F_Personnalise"
End Sub

V-C-5. Choix 6 : Choix d'un critère précis

 
Sélectionnez

        ' Cas correspondant au choix d'une valeur précise dans la liste
            FiltrerLesDonnees
            DependanceListes
            GenererFiltre


Cette partie de la procédure lance 3 routines.
Dans un premier temps je génére la syntaxe SQL en fonction de la valeur sélectionnée puis je mets à jour les listes déroulantes et enfin je lance l'exécution des filtres

 
Sélectionnez

Sub FiltrerLesDonnees()
    ' Génération de la syntaxe SQL
    If IsNumeric(Me.ActiveControl.Column(1)) Then
        p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).NomChamp & " = " & Me.ActiveControl.Column(1)
    Else
        p_tabCriteres(p_bytOrdreCbo).Sql = p_tabCriteres(p_bytOrdreCbo).NomChamp & " = '" & Me.ActiveControl.Column(1) & "'"
    End If
End Sub


Les choix étant faits, les syntaxes étant créées, il nous reste à mettre à jour tous les contrôles.

 
Sélectionnez

Sub ActualisationControle()
    ' Affectation de la source du sous-formulaire
    Me.SF_ResultatFiltre.Form.RecordSource = cstSourceFiltre & p_strSqlWhere & p_strSqlOrderBy
    Me.lstEmploye.RowSource = cstSourceFiltre & p_strSqlWhere & p_strSqlOrderBy
    
    ' réactualisation des listes
    ' Initialisation du tableau des critères de filtre et du tableau des anciennes valeurs des listes
        p_intCompteur = 1
        For Each m_ctlCombo In Controls
            If m_ctlCombo.ControlType = acComboBox Then
                ' Affichage de la mention " ---Tous--- " dans chaque liste
                    p_tabAnciennesValeursCombo(p_intCompteur) = m_ctlCombo
                ' Réactualisation des listes
                AlimentationDesListes (m_ctlCombo.Name)
                ' incrémentation du compteur
                p_intCompteur = p_intCompteur + 1
            End If
        Next
            
    ' Mise à jour du sous-formulaire
    Me.SF_ResultatFiltre.Requery
    Me.lstEmploye.Requery

End Sub

V-C-6. Rappel de la procédure complète

 
Sélectionnez

Sub ListesMultifonctions()
        NumeroterListe
        ' Récupération de la valeur actuelle de la liste
        p_bytValeurListe = Me.ActiveControl
 
    Select Case p_bytValeurListe
        ' Cas Tri Croissant ou Tri décroissant
        Case Is = 1, 2
            ' Réaffichage de la valeur antérieure de la liste
            Me.Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
            AffichageOrdreCle
            GenererTri
        ' Cas d'effacement de la clé en cours et réorganisation des clés existantes
        Case Is = 3
            ' Réaffichage de la valeur antérieure de la liste
            Me.Controls("cbo" & p_tabCriteres(p_bytOrdreCbo).NomChamp) = p_tabAnciennesValeursCombo(p_bytOrdreCbo)
            EffacerUneCle
            GenererTri
        ' Cas du réaffichage de la mention " ---Tous--- " dans la liste
        Case Is = 4
            Me.Controls("txtSql" & p_bytOrdreCbo).Visible = False
            EffacerFiltre
            DependanceListes
            GenererFiltre
        ' Cas correspondant au choix de la création d'un filtre multicritères sur un champ
        Case Is = 5
            DoCmd.OpenForm "F_Personnalise", acNormal
        Case Else
        ' Cas correspondant au choix d'une valeur précise dans la liste
            FiltrerLesDonnees
            DependanceListes
            GenererFiltre
   End Select
                
    ActualisationControle
  
End Sub

V-D. Les boutons

Les boutons vont nous permettre de supprimer soit l'ensemble des tris, soit l'ensemble des filtres, soit tout.

V-D-1. Effacer tous les tris


Cette procédure réinitialise les variables (p_strSqlOrderBy et m_bytOrdreCle), masque les images et la numérotation des clés et redimensionne le tableau m_tabCles.

 
Sélectionnez

Private Sub btnEffacerClesTri_Click()
    Dim ctlCombo As Control
    
    ' Efface le contenu de la variable p_strSqlOrderBy
    p_strSqlOrderBy = ""
    
    ' Masque l'ordre des clés et les repères de tris
    For p_intCompteur = 1 To 4
        Me.Controls("txtNumCle" & p_intCompteur).Visible = False
        Me.Controls("imgAsc" & p_intCompteur).Visible = False
        Me.Controls("imgDesc" & p_intCompteur).Visible = False
    Next
    
    ' Initialise le compteur de clés
    m_bytOrdreCle = 0
    
    ' Réinitialisation de la variable m_tabCles
    ReDim m_tabCles(4)
    
    ' Réactualisation des contrôles
    ActualisationControle
    
End Sub

V-D-2. Effacer tous les filtres


Cette procédure a pour objet de masquer toutes les zones de texte, effacer les données du tableau p_tabCriteres, réaffecter la valeur "--- Tous ---" à toutes les listes déroulantes et enfin réinitialiser les variables p_strWhere... de chaque liste.

 
Sélectionnez

Private Sub btnEffacerFiltre_Click()
    Dim l_bytCompteurBoucle As Byte
    
    For l_bytCompteurBoucle = 1 To 4
        ' Masque le post'it affichant la clause WHERE
        Me.Controls("txtSql" & l_bytCompteurBoucle).Visible = False
        
        ' Efface le contenu du tableau des critères
        Erase p_tabCriteres(l_bytCompteurBoucle).CodeOp
        Erase p_tabCriteres(l_bytCompteurBoucle).Comparaison
        p_tabCriteres(l_bytCompteurBoucle).OpLogique = ""
        p_tabCriteres(l_bytCompteurBoucle).Sql = ""
        Erase p_tabCriteres(l_bytCompteurBoucle).ValCritere
    Next
    
    ' Affiche la mention " ---Tous--- " dans toutes les listes
    For Each m_ctlCombo In Controls
        If m_ctlCombo.ControlType = acComboBox Then
            m_ctlCombo = 4
        End If
    Next
    
    ' Réinititalisation des variables
    p_strSqlWhere = ""
    p_strWhereListeAgence = ""
    p_strWhereListeDiplome = ""
    p_strWhereListeFamille = ""
    p_strWhereListePoste = ""
    
    ActualisationControle
End Sub

V-D-3. Effacer tout

Petite procédure qui relance les routines des évènements "sur clic" des boutons btnEffacerClesTri et btnEffacerFiltre.

 
Sélectionnez

Private Sub btnEffacerTout_Click()
    ' Supprime toutes les clés et tous les filtres
    Call btnEffacerClesTri_Click
    Call btnEffacerFiltre_Click
End Sub

VI. CONCLUSION

Ceci reste un exemple supplémentaire de formulaire de recherche multicritères. Il nous montre simplement la richesse des capacités du produit (si celles-ci étaient encore à démontrer !...).

VII. REMERCIEMENTS

Merci à Arkham46 pour ses conseils techniques.
Egalement à Philippe Jochmans pour sa relecture attentive.

VIII. TELECHARGEMENT

 

Vous pouvez télécharger la base de données exemple : Listes Multifonctions

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+