4 pièce(s) jointe(s)
Filtres et Tri dynamique d'une liste de choix
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.Pièce jointe 173668
En saisissant dans l’une des zones prévue à cet effet la liste se réduit automatiquement.
Pièce jointe 173669
On peut combiner les filtres :
Pièce jointe 173670
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 :
Pièce jointe 173671
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 :
Code:
“SELECT ITLOT, PRDNO, DESCP, QUANT FROM T_Transferts “
Sur changement de chaque zone de texte j’ai le code suivant :
Code:
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 |
Chacun transmettant à la procédure FiltreListe un index différent.
La procédure filtre liste est la suivante :
Code:
1
2
3
| Sub FiltreListe(ByVal pnIndex As Integer)
Btn_Filtre.Enabled = AppliqueFiltreListe(Me, L_Transferts, pnIndex, csListeChamps, csTypeChamps)
End Sub |
Elle appelle la procédure AppliqueFiltreListe en lui donnant les paramètres suivant :
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 :
Code:
Const csListeChamps = "ITLOT;PRDNO;DESCP"
Et une seconde constant pour savoir si les champs sont de type numérique ou pas, dans mon cas
Code:
Const csTypeChamps = "0;0;0"
(mettre -1 a la place du 0 si la colonne est de type numérique)
La procédure AppliqueFiltreListe est définie comme suit :
Code:
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 |
Cette procédure construit la clause Where de ma liste en fonction des filtres.
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 :
Code:
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 |
Et AnnuleFiltreListe :
Code:
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 |
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.
Ensuite dans le formulaire sur le bouton qui annule les filtres on aura le code suivant :
Code:
1
2
3
| Private Sub Btn_Filtre_Click()
OteFiltre
End Sub |
avec :
Code:
1
2
3
4
5
|
Sub OteFiltre()
AnnuleFiltreListe Me, L_Transferts, csListeChamps
Btn_Filtre.Enabled = False
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.
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 :mrgreen:
Easy non ? :mouarf:
Pour les tris c’est encore plus simple :
Sur double click des étiquettes nous aurons le code suivant :
Code:
1
2
3
| Private Sub Et_Lot_DblClick(Cancel As Integer)
TriObjetListe L_Transferts, "ITLOT"
End Sub |
On passe en paramètre simplement la liste (objet control) et le nom du champ sur lequel on veut trier.
Et dans un module on retrouve la procédure de tri :
Code:
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 |
A vous de jouer maintenant :D
