Bonjour,
L’idée de cette publication est de mettre à disposition un peu de code afin de filtrer et/ou de trier de manière simple une zone de liste de choix.
En saisissant dans l’une des zones prévue à cet effet la liste se réduit automatiquement.
On peut combiner les filtres :
Et annuler tous les critères grâce au bouton prévu à cet effet.
En double cliquant aussi sur les étiquettes de colonne, on tri la première fois de façon ascendant et la seconde de façon descendante, etc, sur la colonne choisie.
L’idée est d’avoir des routines simple, qui puissent être utilisées avec n’importe quelle liste de choix dès lors que l’on respecte certains prérequis.
Dans un premier temps, placer tous vos objets :
Pour faire fonctionner les filtres :
Donner aux champs de critère le même nom que les champs contenu dans votre requête source de votre liste sur lesquels on devra réaliser les filtres :
Dans mon exemple, mes Champs s’appellent : ITLOT, PRDNO et DESCP et la requête source de ma liste est :
Sur changement de chaque zone de texte j’ai le code suivant :
Code : Sélectionner tout - Visualiser dans une fenêtre à part SELECT ITLOT, PRDNO, DESCP, QUANT FROM T_Transferts
Chacun transmettant à la procédure FiltreListe un index différent.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11 Private Sub ITLOT_Change() FiltreListe 0 End Sub Private Sub PRDNO_Change() FiltreListe 1 End Sub Private Sub DESCP_Change() FiltreListe 2 End Sub
La procédure filtre liste est la suivante :
Elle appelle la procédure AppliqueFiltreListe en lui donnant les paramètres suivant :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Sub FiltreListe(ByVal pnIndex As Integer) Btn_Filtre.Enabled = AppliqueFiltreListe(Me, L_Transferts, pnIndex, csListeChamps, csTypeChamps) End Sub
Le formulaire dans lequel je me trouve (pour récupérer le contenu des différents champs de filtre),
Le control de la liste de choix pour pouvoir lui appliquer les filtres,
Une constante csListeChamps déclaré dans le formulaire et dans mon cas :
Et une seconde constant pour savoir si les champs sont de type numérique ou pas, dans mon cas
Code : Sélectionner tout - Visualiser dans une fenêtre à part Const csListeChamps = "ITLOT;PRDNO;DESCP"
(mettre -1 a la place du 0 si la colonne est de type numérique)
Code : Sélectionner tout - Visualiser dans une fenêtre à part Const csTypeChamps = "0;0;0"
La procédure AppliqueFiltreListe est définie comme suit :
Cette procédure construit la clause Where de ma liste en fonction des filtres.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36 Function AppliqueFiltreListe(poForm As Form, poListBox As ListBox, ByVal pnIndex As Integer, ByVal psControls As String, ByVal psNumeric As String) As Boolean Dim vsFilter As String Dim vsControlFilter As String Dim vtControls() As String Dim vtNumeric() As String Dim vnNbrChamps As Integer Dim vsSQL As String Dim vnPos As Long Dim I As Integer vtControls = Split(psControls, ";") vtNumeric = Split(psNumeric, ";") vnNbrChamps = UBound(vtControls) For I = 0 To vnNbrChamps vsControlFilter = FiltreControl(poForm.Controls(vtControls(I)), I = pnIndex, Val(vtNumeric(I))) If vsControlFilter <> "" Then If vsFilter = "" Then vsFilter = vsControlFilter Else vsFilter = vsFilter & " AND " & vsControlFilter End If End If Next If vsFilter <> "" Then vnPos = InStr(1, poListBox.RowSource, "WHERE") If vnPos = 0 Then vsSQL = poListBox.RowSource & " WHERE " & vsFilter Else vsSQL = Mid(poListBox.RowSource, 1, vnPos - 1) & "WHERE " & vsFilter End If poListBox.RowSource = vsSQL poListBox.Requery AppliqueFiltreListe = True Else AnnuleFiltreListe poForm, poListBox, psControls End If End Function
Attention si votre liste contenait déjà une clause Where faite une requête que vous enregistrerez et en source faite uniquement un « select * From MaRequête »
Cette procédure appelle aussi deux autres sous procédure :
FiltreControl :
Et AnnuleFiltreListe :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21 Function FiltreControl(poField As Control, ByVal pbSaisie As Boolean, Optional ByVal pbNumeric As Boolean) As String If pbSaisie Then If poField.Text <> "" Then If pbNumeric Then FiltreControl = poField.Name & " = " & poField.Text Else FiltreControl = poField.Name & " Like '*" & poField.Text & "*'" End If End If Else If Not IsNull(poField) Then If poField <> "" Then If pbNumeric Then FiltreControl = poField.Name & " = " & poField Else FiltreControl = poField.Name & " Like '*" & poField & "*'" End If End If End If End If End Function
Toutes ces procédure et fonctions doivent se trouver dans un module afin d’être partagé avec tous les formulaires qui pourraient en avoir besoin.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 Sub AnnuleFiltreListe(poForm As Form, poListBox As ListBox, psControls As String) Dim vtControls() As String Dim vnNbrChamps As Integer Dim vsSQL As String Dim vnPos As Long Dim I As Integer vtControls = Split(psControls, ";") vnNbrChamps = UBound(vtControls) For I = 0 To vnNbrChamps poForm.Controls(vtControls(I)) = Null Next vnPos = InStr(1, poListBox.RowSource, " WHERE") If vnPos > 0 Then vsSQL = Mid(poListBox.RowSource, 1, vnPos) End If poListBox.RowSource = vsSQL poListBox.Requery poForm.Controls(poListBox.Name).SetFocus End Sub
Ensuite dans le formulaire sur le bouton qui annule les filtres on aura le code suivant :
avec :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Private Sub Btn_Filtre_Click() OteFiltre End Sub
Le bouton ne doit pas être actif au départ mais c’est le fait de saisir dans une zone de filtre qui l’activera.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Sub OteFiltre() AnnuleFiltreListe Me, L_Transferts, csListeChamps Btn_Filtre.Enabled = False End Sub
De la même manière si on vide sa saisie sans appuyer sur le bouton, il se désactivera également.
Et voila pour les filtres
Easy non ?
Pour les tris c’est encore plus simple :
Sur double click des étiquettes nous aurons le code suivant :
On passe en paramètre simplement la liste (objet control) et le nom du champ sur lequel on veut trier.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Private Sub Et_Lot_DblClick(Cancel As Integer) TriObjetListe L_Transferts, "ITLOT" End Sub
Et dans un module on retrouve la procédure de tri :
A vous de jouer maintenant
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24 Sub TriObjetListe(poListe As Control, ByVal psChamp As String) Dim vsSQL As String Dim vsOrder As String Dim vnPos As Long With poListe vsSQL = .RowSource vnPos = InStr(1, vsSQL, "ORDER BY") If vnPos = 0 Then vsOrder = "ORDER BY " & psChamp Else vsOrder = Mid(vsSQL, vnPos) If InStr(1, vsOrder, psChamp) > 0 Then If InStr(1, vsOrder, "DESC") > 0 Then vsOrder = "ORDER BY " & psChamp Else vsOrder = "ORDER BY " & psChamp & " DESC" End If Else vsOrder = "ORDER BY " & psChamp End If End If .RowSource = Mid(vsSQL, 1, vnPos - 1) & vsOrder End With End Sub![]()
Partager