I. Introduction▲
Dans l'article "Listes multifonctions", nous avions étudié comment combiner les tris et le choix de critères personnalisés ou sur une seule valeur. Cette fois-ci, je vous propose de voir, d'une manière relativement simple, comment préserver ces critères de sélection ou les clés de tri posés en les enregistrant dans une table. On verra aussi comment réafficher ces filtres ou comment les supprimer.
II. Structure de la nouvelle table▲
Nom du Champ | Type de données | Propriétés |
---|---|---|
CodeFiltre | NumeroAuto | Taille : Entier Long |
TitreFiltre | Texte Court | Taille : 255 |
DateFiltre | Date/Heure | Valeur par défaut : Date() |
SqlWhere | Texte Long | |
SqlOdreBy | TexteCourt | Taille : 255 |
III. Le formulaire▲
III-A. Présentation▲
III-A-1. Quelques rappels indispensables▲
Afin d'alléger les lignes de programme, les éléments statiques sont mémorisés dans des constantes de portée projet (donc déclarées dans un module spécifique nommé : "DéclarationsGenerales".
Le nom de toutes les variables et constantes sont bâties sur le même schéma :
- la portée ;
- le type ;
- le nom de la variable.
Exemple : l_strSqlWhere
l : portée locale ;
str : Type String ;
SqlWhere : Nom de la variable
' Déclaration des Constantes de portée Projet
' 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 "
III-A-2. Les nouveaux boutons du formulaire▲
Comme vous pouvez le remarquer sur l'image ci-dessus, il y a deux boutons. Je ne vous ferez pas l'injure de vous expliquer comment on procède pour les poser sur le formulaire. Simplement, vous noterez les noms de ceux-ci :
- btnEnregistrerFiltre (n°1)
- btnSupprimerFiltre (n°2)
III-A-3. La zone de liste▲
Ce contrôle est une zone de liste dont les propriétés sont les suivantes :
- Nom du Contrôle : lstHistoFiltres ;
- Contenu : SELECT CodeFiltre, TitreFiltre, DateFiltre FROM T_HistoriqueFiltres ORDER BY DateFiltre DESC;
- largeur : 13.6cm
- Nombre de colonnes : 3 ;
- Taille : 0cm; 11,5cm, 2cm
III-B. Le code VBA▲
III-B-1. Le bouton "btnEnregistrerFiltre"▲
L'événement sur clic de ce contrôle va provoquer une alerte auprès de l'utilisateur qui sera convié à confirmer son intention d'enregistrer la séquence Sql en cours.
L'enregistrement se fera par l'intermédiaire d'une requête INSERT INTO.
Private
Sub
btnEnregistrerFiltre_Click
(
)
' Initialisation des variables
Dim
l_intreponse As
Integer
Dim
l_strSql As
String
, l_strTitre As
String
' Alerte l'Utilisateur
l_intreponse =
MsgBox
(
"Vous allez enregistrer le filtre en cours"
&
vbCrLf
&
"Souhaitez-vous continuer ?"
, vbQuestion
+
vbYesNo
, "Gestion des filtres"
)
' Analyse de la réponse
If
l_intreponse =
vbYes
Then
l_strTitre =
InputBox
(
"Saisir un titre pour votre filtre"
)
' Initialisation de la sequence Sql à exécuter
If
p_strSqlOrderBy =
""
Then
' Pas de clé de tri mais critères de sélection
l_strSql =
"INSERT INTO T_HistoriqueFiltres (TitreFiltre, SqlWhere) VALUES ('"
&
l_strTitre &
"',"
&
Chr
(
34
) &
p_strSqlWhere &
Chr
(
34
) &
")"
ElseIf
p_strSqlWhere =
""
Then
' Pas de critères de sélection mais clés de tri
l_strSql =
"INSERT INTO T_HistoriqueFiltres (TitreFiltre, SqlOrderBy) VALUES ('"
&
l_strTitre &
"',"
&
Chr
(
34
) &
p_strSqlOrderBy &
Chr
(
34
) &
")"
Else
' Critères de sélection et clés de tri
l_strSql =
"INSERT INTO T_HistoriqueFiltres (TitreFiltre, SqlWhere, SqlOrderBy) VALUES ('"
&
l_strTitre &
"',"
&
Chr
(
34
) &
p_strSqlWhere &
Chr
(
34
) &
","
&
Chr
(
34
) &
p_strSqlOrderBy &
Chr
(
34
) &
")"
End
If
' Execute la requête
With
DoCmd
.SetWarnings
False
.RunSQL
l_strSql
.SetWarnings
True
End
With
' MAJ de la liste des filtres mémorisés
Me.lstHistoFiltres.Requery
Else
' Annulation de la procédure d'enregistrement
MsgBox
"Enregistrement du filtre abandonné !"
, vbInformation
, "Gestion des filtres"
End
If
End
Sub
III-B-2. Le bouton "btnSupprimerFiltre"▲
L'événement sur clic de ce contrôle va provoquer une alerte auprès de l'utilisateur qui sera convié à confirmer son intention de supprimer la filtre de la liste sélectionné.
L'enregistrement se fera par l'intermédiaire d'une requête DELETE.
Private
Sub
btnSupprimerFiltre_Click
(
)
' Initialisation des variables
Dim
l_intreponse As
Integer
Dim
l_strSql As
String
' Test de vérification de la sélection d'un item de la liste
If
Me.lstHistoFiltres
>
0
Then
' Alerte l'utilisateur
l_intreponse =
MsgBox
(
"Vous allez supprimer le filtre : "
&
vbCrLf
&
Me.lstHistoFiltres.Column
(
1
) &
vbCrLf
&
vbCrLf
&
"Souhaitez-vous continuer ?"
, vbExclamation
+
vbYesNo
, "Gestion des filtres"
)
' Analyse de la réponse
If
l_intreponse =
vbYes
Then
' Initialisation de la requete
l_strSql =
"DELETE FROM T_HistoriqueFiltres WHERE CodeFiltre = "
&
Me.lstHistoFiltres
' Exécution de la requete
With
DoCmd
.SetWarnings
False
.RunSQL
l_strSql
.SetWarnings
True
End
With
' MAJ de la liste
Me.lstHistoFiltres.Requery
Else
' Annulation de la procédure de suppression
MsgBox
"L'opération de Suppression du filtre :"
&
vbCrLf
&
Me.lstHistoFiltres.Column
(
1
) &
vbCrLf
&
" a été annulée !"
, vbExclamation
, "Gestion des filtres"
End
If
Else
' Message d'alerte
MsgBox
"Vous n'avez pas sélectionné le filtre à supprimer"
End
If
End
Sub
III-B-3. La liste "lstHistoFiltres"▲
L'objectif : afficher dans le formulaire le résultat du filtre mémorisé sur lequel on aura double-cliqué.
Mais, pour être complet, il faudra également renseigner les listes déroulantes ou les bulles Sql qui apparaissent lorsdqu'il s'agit d'un filtre personnalisé.
D'autre part, il sera également nécessaire d'afficher l'ordre des clés et leur sens.
Bien sûr les listes lstResultatFiltre et lstEmploye seront mises à jour.
Pour ce contrôle nous poserons donc l'événement sur le double clic.
III-B-3-a. Afficher les critères▲
Pour cet affichage, nous avons deux situations :
- un seul critère et dans ce cas seul la liste concernée affiche la valeur du critère ;
- plusieurs critères et dans ce cas, la liste doit afficher l'option "personnalisé ..." et la bulle Sql doit afficher l'ensemble des critères.
III-B-3-a-i. Déclarations des variables▲
Avant de commencer, je voudrais vous présenter les différentes variables qui vont entrer en jeu dans cette procédure :
Nom de la variable | Type | Objet |
---|---|---|
l_strSql | String | Utilisée pour rafraichir les listes : lstResultatFiltre et lstEmploye |
l_strSqlWhere | String | Utilisée pour récupérer le contenu du champ : SqlWhere |
l_strSqlOrderBy | String | Utilisée pour récupérer le contenu du champ : SqlOrderBy |
l_strNomTable l_strNomChamp l_strCritere |
String | Utilisées pour récupérer par la fonction DLookUp() le contenu de la liste déroulante concernée par le critère |
l_tabSqlWherer/> l_tabSqlOrderBy | Variant | Variables de type tableau utilisées pour la récupération des contenus des chaînes l_strSqlWhere et l_strSqlOrderBy par l'intermédiaire de la fonction Split() |
l_intCompteur | Integer | Utilisée lors de l'analyse du tableau l_tabSqlOrderBy |
l_intNumCle | Integer | Utilisée pour afficher l'ordre des clés dans le formulaire |
l_intNumCombo | Integer | Utilisée pour repérer le numéro de la liste déroulante concernée |
III-B-3-a-ii. Récupération des données de la table▲
La première étape consiste à récupérer les données mémorisées dans la table.
Je rappelle que nous disposons de deux champs (SqlWhere et SqlOrderBy). Nous utiliserons la fonction DLookup.
' Recherche des expressions Sql
l_strSqlWhere =
Nz
(
DLookup
(
"SqlWhere"
, "T_HistoriqueFiltres"
, "CodeFiltre = "
&
Me.ActiveControl
), ""
)
J'y ai adjoint la fonction Nz() pour gérer la situation d'un filtre dont un des deux champs serait vide (SqlWhere ou SqlOrderBy).
III-B-3-a-iii. Initialisation des variables▲
' Initialisation de la chaine Sql WHERE et ORDERBY
If
l_strSqlOrderBy =
""
Then
l_strSql =
l_strSqlWhere
l_tabSqlWhere =
Split
(
Mid
(
l_strSqlWhere, 9
, Len
(
l_strSqlWhere) -
9
), " "
)
ElseIf
l_strSqlWhere =
""
Then
l_strSql =
l_strSqlOrderBy
l_tabSqlOrderBy =
Split
(
Mid
(
l_strSqlOrderBy, 10
, Len
(
l_strSqlOrderBy) -
9
), " "
)
Else
l_strSql =
l_strSqlWhere &
l_strSqlOrderBy
l_tabSqlWhere =
Split
(
Mid
(
l_strSqlWhere, 9
, Len
(
l_strSqlWhere) -
9
), " "
)
l_tabSqlOrderBy =
Split
(
Mid
(
l_strSqlOrderBy, 10
, Len
(
l_strSqlOrderBy) -
9
), " "
)
End
If
Vous remarquerez que le Split ne se fait que sur une partie du contenu de chaque champ récupéré. En effet, il est inutile de s'embarasser de mots inutiles comme "WHERE " ou "ORDER BY" dans notre analyse.
Nous récupérons la chaine de caractères suivante :
- dans le cas d'un filtre simple : AGENCE = 'LILLE'
- dans le cas d'un filtre personnalisé : AGENCE = 'NICE' OR AGENCE = 'RENNES'
III-B-3-b. Afficher les clés de tri▲
Pour récupérer des données de la table, nous utiliserons le même procédé que pour la récupération des critères. C'est à dire la fonction DLookup()
l_strSqlOrderBy =
Nz
(
DLookup
(
"SqlOrderBy"
, "T_HistoriqueFiltres"
, "CodeFiltre = "
&
Me.ActiveControl
), ""
)
La chaine traitée après l'extraction par la fonction Mid() nous donne le résultat suivant : DIPLOME asc, POSTEOCCUPE desc
La fonction Split() éclatera donc cette chaine dans un tableau et au regard du résultat, une simple boucle nous permettra de connaître l'intitulé des champs clés.
Cependant quelques questions se posent :
Quelle sera la limite de la boucle ? | On l'obtiendra par la fonction Ubound() |
Comment récupérer l'intitulé du champ clé ? | Le champ clé se trouve dans les lignes impaires du tableau. |
Comment reconnaitre le sens du tri | En consultant le premier caractère de chaque valeur des lignes paires par l'utilisation la fonction Left() |
Comment gérer la hiérarchie des clés ? | Par l'incrémentation de la variable l_intNumCle. Cette gestion de la hiérarchie nous amène à penser que le numéro de clé ne doit s'incrémenter qu'après analyse de l'intitulé de la clé et du sens du tri. En conséquence, nous utiliserons un "Step" de 2 pour gérer les deux informations simultanément dans un seul tour de boucle. Ce qui donne le code ci-dessous : |
' Traitement de la variable l_strSqlOrderBy
If
Len
(
l_strSqlOrderBy) >
0
Then
If
UBound
(
l_tabSqlOrderBy) <>
0
Then
' Boucle en fonction du nombre de clés
For
l_intCompteur =
1
To
UBound
(
l_tabSqlOrderBy) Step
2
' Compteur du n° d'ordre de la clé
l_intNumCle =
l_intNumCle +
1
' Repère le n° de la combo concernée par la clé
Select
Case
l_tabSqlOrderBy
(
l_intCompteur)
Case
Is
=
"AGENCE"
l_intNumCombo =
1
Case
Is
=
"DIPLOME"
l_intNumCombo =
2
Case
Is
=
"POSTEOCCUPE"
l_intNumCombo =
3
Case
Is
=
"SITUATIONFAMILLE"
l_intNumCombo =
4
End
Select
' Affichage du n° d'ordre de la clé
With
Me.Controls
(
"txtNumCle"
&
l_intNumCombo)
.Value
=
l_intNumCle
.Visible
=
True
End
With
' Recherche le sens du tri
If
Left
(
l_tabSqlOrderBy
(
l_intCompteur +
1
), 1
) =
"a"
Then
' Affiche le logo de tri croissant
Me.Controls
(
"imgAsc"
&
l_intNumCombo).Visible
=
True
Me.Controls
(
"imgDesc"
&
l_intNumCombo).Visible
=
False
Else
' Affiche le logo de tri décroissant
Me.Controls
(
"imgAsc"
&
l_intNumCombo).Visible
=
False
Me.Controls
(
"imgDesc"
&
l_intNumCombo).Visible
=
True
End
If
Next
End
If
End
If
III-B-3-c. Mettre à jour les résultats▲
On peut maintenant modifier la propriété RecordSource du sous-formulaire SF_ResultatFiltre et la propriété RowSource de la liste lstEmploye
' Mise à jour des listes en fonction de la requête
With
Me.SF_ResultatFiltre.Form
.RecordSource
=
cstSourceFiltre &
l_strSql
.Requery
End
With
Me.lstEmploye.RowSource
=
cstSourceFiltre &
l_strSql
III-B-4. Le code dans son ensemble▲
Après avoir décortiqué l'ensemble du code, il est temps d'avoir une vue d'ensemble de celui-ci :
Private
Sub
lstHistoFiltres_DblClick
(
Cancel As
Integer
)
' Déclaration des variables
Dim
l_strSql As
String
, l_strSqlWhere As
String
, l_strSqlOrderBy As
String
Dim
l_strNomTable As
String
, l_strNomChamp As
String
, l_strCritere As
String
Dim
l_tabSqlWhere As
Variant
, l_tabSqlOrderBy As
Variant
Dim
l_intCompteur As
Integer
, l_intNumCle As
Integer
, l_intNumCombo As
Integer
' Supprime toutes les clés et tous les filtres
Call
btnEffacerClesTri_Click
Call
btnEffacerFiltre_Click
' Recherche des expressions Sql
l_strSqlWhere =
Nz
(
DLookup
(
"SqlWhere"
, "T_HistoriqueFiltres"
, "CodeFiltre = "
&
Me.ActiveControl
), ""
)
l_strSqlOrderBy =
Nz
(
DLookup
(
"SqlOrderBy"
, "T_HistoriqueFiltres"
, "CodeFiltre = "
&
Me.ActiveControl
), ""
)
' Initialisation de la chaine Sql WHERE et ORDERBY
If
l_strSqlOrderBy =
""
Then
l_strSql =
l_strSqlWhere
l_tabSqlWhere =
Split
(
Mid
(
l_strSqlWhere, 9
, Len
(
l_strSqlWhere) -
9
), " "
)
ElseIf
l_strSqlWhere =
""
Then
l_strSql =
l_strSqlOrderBy
l_tabSqlOrderBy =
Split
(
Mid
(
l_strSqlOrderBy, 10
, Len
(
l_strSqlOrderBy) -
9
), " "
)
Else
l_strSql =
l_strSqlWhere &
l_strSqlOrderBy
l_tabSqlWhere =
Split
(
Mid
(
l_strSqlWhere, 9
, Len
(
l_strSqlWhere) -
9
), " "
)
l_tabSqlOrderBy =
Split
(
Mid
(
l_strSqlOrderBy, 10
, Len
(
l_strSqlOrderBy) -
9
), " "
)
End
If
' Traitement de la variable l_strSqlWhere
If
Len
(
l_strSqlWhere) >
0
Then
' Initialisation du Variables nécessaires pour le DLookUp et pour le repérage de la liste concerné
Select
Case
l_tabSqlWhere
(
0
)
Case
Is
=
"AGENCE"
l_intNumCombo =
1
l_strNomTable =
"T_Agences"
l_strNomChamp =
"CodeAgence"
l_strCritere =
"Agence"
Case
Is
=
"DIPLOME"
l_intNumCombo =
2
l_strNomTable =
"T_Diplomes"
l_strNomChamp =
"CodeDiplome"
l_strCritere =
"Diplome"
Case
Is
=
"POSTEOCCUPE"
l_intNumCombo =
3
l_strNomTable =
"T_PosteOccupe"
l_strNomChamp =
"CodePosteOccupe"
l_strCritere =
"PosteOccupe"
Case
Is
=
"SITUATIONFAMILLE"
l_intNumCombo =
4
l_strNomTable =
"T_SituationFamille"
l_strNomChamp =
"CodeSituationFamille"
l_strCritere =
"SituationFamille"
End
Select
' Recherche si la sequence Sql concerne un seul critère ou une peersonnalisation
If
UBound
(
l_tabSqlWhere) <
3
Then
' initialisation du contenu de la liste déroulante
Me.Controls
(
"cbo"
&
l_tabSqlWhere
(
0
)) =
DLookup
(
l_strNomChamp, l_strNomTable, l_strCritere &
" = "
&
l_tabSqlWhere
(
2
)) +
5
Else
' initialisation du contenu de la liste déroulante sur l'option "Personnalisée ..."
Me.Controls
(
"cbo"
&
l_tabSqlWhere
(
0
)) =
5
' Alimentation de la bulle SQL
With
Me.Controls
(
"txtSql"
&
l_intNumCombo)
.Value
=
Mid
(
l_strSqlWhere, 9
, Len
(
l_strSqlWhere) -
9
)
.Visible
=
True
End
With
End
If
End
If
' Traitement de la variable l_strSqlOrderBy
If
Len
(
l_strSqlOrderBy) >
0
Then
If
UBound
(
l_tabSqlOrderBy) <>
0
Then
' Boucle en fonction du nombre de clés
For
l_intCompteur =
1
To
UBound
(
l_tabSqlOrderBy) Step
2
' Compteur du n° d'ordre de la clé
l_intNumCle =
l_intNumCle +
1
' Repère le n° de la combo concernée par la clé
Select
Case
l_tabSqlOrderBy
(
l_intCompteur)
Case
Is
=
"AGENCE"
l_intNumCombo =
1
Case
Is
=
"DIPLOME"
l_intNumCombo =
2
Case
Is
=
"POSTEOCCUPE"
l_intNumCombo =
3
Case
Is
=
"SITUATIONFAMILLE"
l_intNumCombo =
4
End
Select
' Affichage du n° d'ordre de la clé
With
Me.Controls
(
"txtNumCle"
&
l_intNumCombo)
.Value
=
l_intNumCle
.Visible
=
True
End
With
' Recherche le sens du tri
If
Left
(
l_tabSqlOrderBy
(
l_intCompteur +
1
), 1
) =
"a"
Then
' Affiche le logo de tri croissant
Me.Controls
(
"imgAsc"
&
l_intNumCombo).Visible
=
True
Me.Controls
(
"imgDesc"
&
l_intNumCombo).Visible
=
False
Else
' Affiche le logo de tri décroissant
Me.Controls
(
"imgAsc"
&
l_intNumCombo).Visible
=
False
Me.Controls
(
"imgDesc"
&
l_intNumCombo).Visible
=
True
End
If
Next
End
If
End
If
' Mise à jour des listes en fonction de la requête
With
Me.SF_ResultatFiltre.Form
.RecordSource
=
cstSourceFiltre &
l_strSql
.Requery
End
With
Me.lstEmploye.RowSource
=
cstSourceFiltre &
l_strSql
End
Sub
IV. Conclusion▲
J'espère, par ces exemples simples, avoir soulevé votre curiosité et votre envie d'ajouter à vos applications cette fonctionnalité qui évitera à vos utilisateurs de recommencer toujours les mêmes opérations et leur faire ainsi gagner un peu de temps.
V. Remerciements▲
Je tiens à remercier : .... pour leurs conseils techniques et ... pour sa relecture attentive
VI. Téléchargements▲
Vous pouvez télécharger la base de données exemple : HistoFiltres.zip. Cette base est au format .mdb