Discussion :

[Didier L]

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 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

“SELECT ITLOT, PRDNO, DESCP, QUANT FROM T_Transferts “

Sur changement de chaque zone de texte j’ai le code suivant :

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

Chacun transmettant à la procédure FiltreListe un index différent.

La procédure filtre liste est la suivante :

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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

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 :

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

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
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Btn_Filtre_Click()
    OteFiltre
End Sub

avec :

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

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

Easy non ?

Pour les tris c’est encore plus simple :
Sur double click des étiquettes nous aurons le code suivant :

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

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 :

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

A vous de jouer maintenant