Discussion :

[Shanur]

Bonjour. je propose une recherche multicritères basée sur une collection.

Pour ce faire, on a besoin, au niveau du formulaire, d'une collection et de ses méthodes d'accès :

Code :

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

1
2
3
4
5
6
7
8
9
Private Fl_col As New Collection
 
Property Set Fl(extFl As Collection)
  Set Fl_col = extFl
End Property
 
Property Get Fl() As Collection
  Set Fl = Fl_col
End Property

Il manque certaines méthodes pour manipuler l'objet Collection. Nous allons y pallier en les placant dans un module.

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
Public Function Collection_tstMembrePresent(extCol As Collection, extName As String) As Boolean
Dim inObj As Object
  On Error Resume Next
  Set inObj = extCol(extName)
  Collection_tstMembrePresent = (Err = 0)
End Function
 
Public Function Collection_tstChargee(extCol As Collection) As Boolean
Dim inLng As Long
  On Error Resume Next
  inLng = extCol.Count
  Collection_tstChargee = (Err = 0)
End Function
 
Public Sub Collection_Destructeur(extCol As Collection)
 
  If Not Collection_tstChargee(extCol) Then Exit Sub
 
  Do While extCol.Count > 1
    extCol.Remove 0
  Loop
 
  Set extCol = Nothing
 
End Sub

Nous pouvons dès lors compléter le formulaire en détruisant la collection lors de l'évènement "Close".

Code :

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

1
2
3
4
5
Private Sub Form_Close()
  .........  
  Collection_Destructeur Fl
  .........  
End Sub

Note : La destruction de la collection n'est pas absolument nécessaire, vu la portée de sa déclaration, mais c'est une bonne habitude à prendre.

Notre collection étant mise en place, il nous faut la remplir avec un objet, dans ce cas-ci ce sera un module de classe.

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
module de classe Fl_gestion
 
Option Compare Database
Option Explicit
 
Private Type rcd
  Filtre      As String
  Active      As Boolean
End Type
 
Dim usr As rcd
 
Property Let Filtre(extFiltre As String)
  usr.Filtre = extFiltre
End Property
Property Get Filtre() As String
  Filtre = usr.Filtre
End Property
 
Property Let Active(extActive As Boolean)
  usr.Active = extActive
End Property
Property Get Active() As Boolean
  Active = usr.Active
End Property

Nous avons la collection et l'objet pour la remplir. Nous pouvons dès lors l'utiliser pour "créer un filtre" dans le formulaire.

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
Private Sub Apartir_Change()
Dim inFilter As String, Fl_cl As New Fl_Gestion
  If Nz(me.Apartir.Text, "") = "" Then
    If Collection_tstMembrePresent(Fl, "Apartir") Then Fl.Remove ("Apartir")
  Else
    inFilter = "Recherche LIKE '" & me.Apartir.Text & "*'"
 
    If Collection_tstMembrePresent(Fl, "Apartir") Then
      Fl("Apartir").Filtre = inFilter
    Else
      Fl_cl.Filtre = inFilter
      Fl.Add Fl_cl, "Apartir"
      Set Fl_Cl = Nothing
    End If
  End If
  AppliquerFiltre
End Sub

Le filtre étant créé, il ne reste plus qu'à l'appliquer au formulaire.

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
Private Sub AppliquerFiltre()
Dim inFiltre As String, PremierPassage As Boolean, Fl_cl As Fl_Gestion
 
  PremierPassage = True
 
  For Each Fl_cl In Fl
    If Not PremierPassage Then inFiltre = inFiltre & " AND "
    inFiltre = inFiltre & Fl_cl.Filtre
    PremierPassage = False
  Next Fl_cl
 
  me.Filter = inFiltre
  me.FilterOn = Not (inFiltre = "")
 
End Sub

Voilà, vous renouvelez l'opération "créer un filtre" autant de fois que vous avez de critères.

Vous pouvez aussi remplacer la méthode "Remove" de la collection par la méthode "Active" de l'objet. Une autre variante consiste à remplir la collection avec tous les filtres (Form_Open) avant l'utilisation du premier filtre. A vos claviers.

[alassanediakite]

Salut
Je pense qu'il est mieux de joindre un fichier access exemple. Cela donne plus d'engouements et aide à comprendre le code.
Merci de la contribution et @+.