Formulaire de recherche multicritères et plus

**Strigbull** · 07/04/2019, 16h56

Bonsoir,
Je viens vers vous pour solutionner un souci de code sur un formulaire de recherche concernant une base sur le theme de la collection de boutons réglementaires français. En fait, je créé un Fallou inversé, pour ceux qui connaissent cet ouvrage. A partir d'elements du bouton je veux pouvoir trouver a quelles unites il a pu appartenir.
Pour cela, j'ai créer une table des boutons (T_Bouton) et différentes tables de critères pour limiter les choix dans mon formulaire de recherche.
Nom : Capture.JPG
Affichages : 452
Taille : 103,2 Ko

Nom : Capture.JPG
Affichages : 452
Taille : 103,2 Ko

Sur l'image du formulaire, on peut voir une zone de recherche par critères en haut, forme, motif principal, couleur... Les valeurs des critères sont limites a la liste. j'ai fait un code simple sur la base d'un tuto revu et ca fonctionne.
dont voici le code

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Private Sub btnRechPredef_Click()
 
 Dim SQL As String
 Dim SQLWhere As String
 
 SQL = "SELECT T_Bouton.* FROM T_Bouton Where T_Bouton!ID_Bouton <> 0 "
 
 
 If Me.cboForme = "" Or IsNull(Me.cboForme) Then
 GoTo SuiteForme
    Else
    SQL = SQL & "And T_Bouton!Forme like '*" & Me.cboForme & "*' "
 End If
 
SuiteForme:
 If Me.cboMotif = "" Or IsNull(Me.cboForme) Then
 GoTo SuiteMotif
    Else
    SQL = SQL & "And T_Bouton!Motif = '" & Me.cboMotif & "' "
 End If
 
SuiteMotif:
 If Me.cboCouleur = "" Or IsNull(Me.cboForme) Then
 GoTo SuiteCouleur
    Else
    SQL = SQL & "And T_Bouton!Couleur like '*" & Me.cboCouleur & "*' "
 End If
 
SuiteCouleur:
 If Me.cboTit_Centrale = "" Or IsNull(Me.cboForme) Then
 GoTo SuiteTit_Centrale
    Else
    SQL = SQL & "And T_Bouton!Tit_Centrale like '*" & Me.cboTit_Centrale & "*' "
 End If
 
SuiteTit_Centrale:
 If Me.cboTit_Perif = "" Or IsNull(Me.cboForme) Then
 GoTo Fin
    SQL = SQL & "And T_Bouton!Tit_Perif = '" & Me.cboTit_Perif & "' "
 End If
 
Fin:
 
 
 SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
 SQL = SQL & ";"
 Me.lblNbreEnr.Caption = DCount("*", "T_Bouton", SQLWhere) & " / " & DCount("*", "T_Bouton")
 Me.lstResultat.RowSource = SQL
 Me.lstResultat.Requery
 
 
End Sub

Plus bas, on a une recherche par champ, on choisit le champ et donne une valeur, le résultat est fonction de l'elements coché à droite (contenir la valeur, par exemple)
C'est un code que j'ai adapted d'une autre base que j'avais déjà crée également sur le theme de la collection. Il n'est pas tres propre mais a le merite de fonctionner egalement.
Voici le code

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Private Sub btnRechercher_Click()
    Dim strTable As String, strField As String, strCriteria As String, strSQL As String
    Dim Criter As Variant
    Dim intTypChamp As Integer
    Dim intOpeChamp As Integer
 
 
    'If IsNull(Me.cboTable) Or IsNull(Me.cboChamp) Then
    If Me.cboChamp = "" Or IsNull(Me.cboChamp) Then
      MsgBox "Vous devez renseigner le champ pour effectuer une recherche !", vbExclamation + vbOKOnly, "Recherche"
      Exit Sub
   End If
 
 
    strTable = "T_Bouton"       ' recupère le nom de la table
    strField = "[" & Me.cboChamp & "]"       ' recupère le nom du champ
 
 
    ' compose le critere de recherche
 
intTypChamp = lf_GetTypeField(strTable, strField)  ' pour trouver le type du champs ...
intOpeChamp = Me.opt_Recherche
 
Select Case intTypChamp
 
       Case dbBoolean                       ' bool
            Select Case intOpeChamp
               Case 1   ' oui
                   strCriteria = strTable & "." & strField & "=-1"
               Case 2   ' non
                   strCriteria = strTable & "." & strField & "=0"
               Case 3
                   strCriteria = "ISNULL(" & strTable & "." & strField & ")"
               Case 4
                   strCriteria = "NOT ISNULL(" & strTable & "." & strField & ")"
             End Select
 
        Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp                  ' traite les numeriques
            If Not IsNull(Me.txtCritere) Then   ' si le null n'est pas la valeur à traiter
               strCriteria = Me.txtCritere
               ' traite la virgule si elle existe
               If InStr(1, Me.txtCritere, ",") > 0 Then strCriteria = Replace(Me.txtCritere, ",", ".", 1)
               ' pour les versions antérieure à la 2000
               'If InStr(1, Me.txtcritere, ",") > 0 Then strCriteria = Left(Me.txtcritere, InStr(1, Me.txtcritere, ",") - 1) & "." & Right(Me.txtcritere, InStr(1, Me.txtcritere, ","))
 
               If intTypChamp = dbDate And IsDate(Me.txtCritere) Then strCriteria = "#" & Me.txtCritere & "#"                   ' type champ = date
               ' rajoute les dièses
             End If
 
             Select Case intOpeChamp                    ' numerique, date
                  Case 1 ' =
                       If IsNull(Me.txtCritere) Then
                          strCriteria = "ISNULL(" & strTable & "." & strField & ")"
                       Else
                          strCriteria = strTable & "." & strField & "=" & strCriteria
                       End If
                  Case 2 ' >=
                       strCriteria = strTable & "." & strField & ">=" & strCriteria
 
                  Case 3 ' <=
                       strCriteria = strTable & "." & strField & "<=" & strCriteria
 
                  Case 4 '<>
                       If IsNull(Me.txtCritere) Then
                          strCriteria = "NOT ISNULL(" & strTable & "." & strField & ")"
                       Else
                          strCriteria = strTable & "." & strField & "<>" & strCriteria
                       End If
             End Select
 
       Case dbText, dbMemo, dbChar                      ' texte
            Select Case intOpeChamp
                Case 1 ' strictement egal
                    If IsNull(Me.txtCritere) Then
                       strCriteria = "ISNULL(" & strTable & "." & strField & ")"
                    Else
                       strCriteria = strTable & "." & strField & " Like """ & Me.txtCritere & """"
                    End If
                Case 2 ' commence par
                    strCriteria = strTable & "." & strField & " Like """ & Me.txtCritere & "*"""
                Case 3 ' contient
                    strCriteria = strTable & "." & strField & " Like ""*" & Me.txtCritere & "*"""
                Case 4 ' fini par
                    strCriteria = strTable & "." & strField & " Like ""*" & Me.txtCritere & """"
                Case 5 ' ne contient pas
                    If IsNull(Me.txtCritere) Then
                       strCriteria = "NOT ISNULL(" & strTable & "." & strField & ")"
                    Else
                       strCriteria = "NOT " & strTable & "." & strField & " Like ""*" & Me.txtCritere & "*"""
                    End If
            End Select
 
       Case Else
            MsgBox "Cas non prévu."
            Exit Sub
   End Select
 
 
 
    If Me.Opt_RechCourante And Not Len(Me.lstResultat.RowSource) = 0 Then
 
        Dim ctrl_table As String
        ctrl_table = Left(strTable, Len(strTable) - 1)
        ctrl_table = Right(ctrl_table, Len(ctrl_table) - 1)
 
        'If Not Me.lstResultat.RowSource Like "*FROM [[]" & ctrl_table & "*" Then
            'MsgBox "La recherche précédente ne porte pas sur la même table que la recherche actuelle.", vbExclamation + vbOKOnly, "Erreur"
            'Exit Sub
        'End If
        SQL = Left(Me.lstResultat.RowSource, Len(Me.lstResultat.RowSource) - 3)
        SQL = SQL & " AND " & strCriteria & "));"
    Else
   ' construit la rq sql
        SQL = "SELECT DISTINCTROW " & strTable & ".*"
        SQL = SQL + " FROM " & strTable
        SQL = SQL + " WHERE ((" & strCriteria & "));"
 
    End If
 
    Me.lstResultat.RowSource = SQL  ' affecte sql a lst_result
    Me.lstResultat.Requery             ' recalcule la liste
 
    Me.txt_ChaineSQL.Value = SQL
 
    'Me.lblNbreEnr.Caption = IIf(Me.lstResultat.ListCount <= 1, 0, Me.lstResultat.ListCount - 1) & "/" & DCount(Me.cboChamp, Me.cboTable)
    'Me.lblNbreEnr.Caption = ""
 
    If Me.lstResultat.ListCount = 0 Or Me.lstResultat.ListCount = 1 Then
        Me.lblNbreEnr.Caption = "Aucun enregistrement trouvé"
    ElseIf Me.lstResultat.ListCount = 2 Then
        Me.lblNbreEnr.Caption = (Me.lstResultat.ListCount - 1) & " " & "enregistrement correspond à votre critère"
    ElseIf Me.lstResultat.ListCount > 2 Then
        Me.lblNbreEnr.Caption = (Me.lstResultat.ListCount - 1) & " " & "enregistrements correspondent à votre critère"
    End If
 
 
End Sub

Ce que je veux en fait, c'est combiner ces deux recherches, c'est a dire n'avoir qu'un bouton de recherche ou je peux sélectionner des critères ou non et peaufiner la recherche sur un champ ou non.
J'ai bien essayed plusieurs solutions mais je coince et suis bloque depuis quelques jours.
J' imagine que pour un expert, ca ne dois pas être un souci mais pour moi qui fait ca occasionnellement

...

J’espère être assez clair, sinon n’hésitez pas a me solliciter.
Merci d'avance pour votre aide
Strig

**EricDgn** · 09/04/2019, 15h06

Bonjour,

Pour ce qui est de la première recherche, je proposerais ceci:

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
Private Sub btnRechPredef_Click()
    Dim sSQL As String
    sSQL = ""
    If Nz(Me.cboForme, "") <> "" Then
        sSQL = sSQL & " And Forme Like '*" & Me.cboForme & "*'"
    End If
    If Nz(Me.cboMotif, "") <> "" Then
        sSQL = sSQL & " And Motif = '" & Me.cboMotif & "'"
    End If
    If Nz(Me.cboCouleur, "") <> "" Then
        sSQL = sSQL & " And Couleur Like '*" & Me.cboCouleur & "*'"
    End If
    If Nz(Me.cboTit_Centrale, "") <> "" Then
        sSQL = sSQL & " And Tit_Centrale Like '*" & Me.cboTit_Centrale & "*'"
    End If
    If Nz(Me.cboTit_Perif, "") <> "" Then
        sSQL = sSQL & " And Tit_Perif = '" & Me.cboTit_Perif & "'"
    End If
    If sSQL <> "" Then
        sSQL = Mid(sSQL, 6)
    End If
    Me.lblNbreEnr.Caption = DCount("*", "T_Bouton", sSQL) & " / " & DCount("*", "T_Bouton")
    Me.lstResultat.RowSource = "SELECT * FROM T_Bouton Where" & sSQL
    Me.lstResultat.Requery
End Sub

Ce qui m'étonne c'est que pour cboForme, cboCouleur, cboTit_Centrale ce sont des LIKE '*xxx*', tandis que pour cboMotif et cboTit_Perif ce sont des = 'xxx'.

Je suppose que quand on a/aura sélectionné quelque chose dans l'un des déroulants du cadre supérieur, ce champ n'est/ne sera plus sélectionnable dans la liste déroulante "Choisir un champ de recherche" (vu qu'il a déjà été choisi).

Cordialement.

**Strigbull** · 10/04/2019, 12h33

Bonsoir et merci pour ton aide Eric,

Sur la base de ta proposition, j'ai revu le code de la première recherche dont voici le résultat :

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Private Sub btnRechPredef_Click()
 
    'Declaration des variables
    Dim sSQL As String
    'Vidange de la requète
    sSQL = ""
 
    If Nz(Me.cboForme, "") <> "" Then 'Gestion du combo Forme
        sSQL = sSQL & " And Forme = '" & Me.cboForme & "'"
    End If
 
    If Nz(Me.cboMotif, "") <> "" Then 'Gestion du combo Motif
        sSQL = sSQL & " And Motif = '" & Me.cboMotif & "'"
    End If
 
    If Nz(Me.cboCouleur, "") <> "" Then 'Gestion du combo Couleur
        sSQL = sSQL & " And Couleur = '" & Me.cboCouleur & "'"
    End If
 
    If Nz(Me.cboTit_Centrale, "") <> "" Then 'Gestion du combo Texte central
        sSQL = sSQL & " And Tit_Centrale = '" & Me.cboTit_Centrale & "'"
    End If
 
    If Nz(Me.cboTit_Perif, "") <> "" Then 'Gestion du combo Titulature
        sSQL = sSQL & " And Tit_Perif = '" & Me.cboTit_Perif & "'"
    End If
 
    If sSQL <> "" Then
        sSQL = Mid(sSQL, 6)
    End If
 
    'Traitement quand le résultat est égal à la totalité de la table des boutons
    If DCount("*", "T_Bouton", [sSQL]) = DCount("*", "T_Bouton") Then
        Me.lstResultat.RowSource = "SELECT * FROM T_Bouton"
        Me.lblNbreEnr.Caption = DCount("*", "T_Bouton", sSQL) & " / " & DCount("*", "T_Bouton") & " " & "enregistrements correspondent à vos critères"
        MsgBox "Vous n'avez pas saisi de critères de recherche!", vbExclamation + vbOKOnly, "Erreur"
    Exit Sub
    End If
 
 
    If DCount("*", "T_Bouton", [sSQL]) = 0 Then 'Affichage quand il n'y a pas de résultat
        Me.lblNbreEnr.Caption = DCount("*", "T_Bouton", sSQL) & " / " & DCount("*", "T_Bouton") & " " & "Aucun enregistrement trouvé"
    ElseIf DCount("*", "T_Bouton", [sSQL]) = 1 Then 'Affichage quand il n'y a qu'un résultat
        Me.lblNbreEnr.Caption = DCount("*", "T_Bouton", sSQL) & " / " & DCount("*", "T_Bouton") & " " & "enregistrement correspond à vos critères"
    ElseIf DCount("*", "T_Bouton", [sSQL]) > 1 Then 'Affichage quand il n'y a plusieurs résultats
        Me.lblNbreEnr.Caption = DCount("*", "T_Bouton", sSQL) & " / " & DCount("*", "T_Bouton") & " " & "enregistrements correspondent à vos critères"
    End If
 
 
    Me.lstResultat.RowSource = "SELECT * FROM T_Bouton Where " & sSQL
    Me.lstResultat.Requery
 
End Sub

Bonsoir et merci pour ton aide Eric,

Sur la base de ta proposition, j'ai revu le code de la première recherche dont voici le résultat :

Pour info, il y a un espace qui manque juste après le Where a la ligne 23 qui empêchait l'affichage.
J'ai supprimé les LIKE et remplacé par des = , pour être homogène. (Je ne sais pas non plus pourquoi, mystère) Toutes les tables concernées par ces recherches sont du texte.
J'ai amélioré la visualisation du comptage des résultats pour qu'un texte apparaisse après les chiffres.
J'ai également traité l'affichage de la liste quand aucun Combo n'est renseigner pour que le résultat affiche toute la Table ( puisqu'il n'y a pas de filtre) et qu'apparaisse une fenêtre pour avertir l'utilisateur; (Ca n'affichait pas de résultat)
Ça peut rendre des services puisque le formulaire "Recherche" permet en cliquant sur un résultat la visualisation de l'image contrairement à la table…
Nom : Capture1.JPG
Affichages : 299
Taille : 273,9 Ko

Nom : Capture1.JPG
Affichages : 299
Taille : 273,9 Ko

Concernant ta question au sujet de la seconde recherche, effectivement, si l'un des Combo de recherche du haut est renseigné, il n'y a pas lieu de faire une recherche sur le même champ au bas. (puisque les choix sont limités à chacune des listes en question)
L'idée de la recherche sur les champs Forme, Motif, … c'est de filtrer grossièrement pour gagner du temps dans la recherche et peaufiner avec la seconde recherche qui devrait se faire principalement sur la description du bouton.
Il est évident qu'en utilisant uniquement la seconde recherche, on y arrivera aussi mais on devra filtrer un à un les champs Forme, Motif,… en faisant la recherche sur le résultat de la recherche précédente. On combinant les deux recherches, on gagnera un temps fou !

Dans le code, on voit apparaitre un strTable = "T_Bouton" , je l'ai volontairement limité a cette table (Le code d'origine vient d'un autre de mes fichiers sur la collection ou il est intéressant de pouvoir rechercher sur différentes tables)
Il y a moyen de rendre ca plus propre, c'est certain, par contre pour les champs, ils peuvent effectivement être de 4 types (Numérique, texte, Y/N, date) c'est pour ça que ces 4 cas sont traites dans le code.

Je cherche également de mon cote mais vu mon niveau, ça prend un temps fou, vu que c’est un peu complexe

encore
Cordialement
Strig

**EricDgn** · 11/04/2019, 11h36

Bonjour,

Personnellement je simplifierais encore ce dispositif de recherche en considérant que la recherche s'effectue systématiquement à chaque mise à jour de chacune des listes déroulantes et du champ texte 'Description'. Chaque mise à jour (AfterUpdate) appellerait la routine "Filtrer". A mon avis cela n'apporte pas vraiment beaucoup d'avoir tous ces cas de figure "égal", "commence par", etc.

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private Sub cboForme_AfterUpdate()   '--- idem pour les autres ComboBox et  txtDescription
    Filtrer
End Sub
 
Private Sub Filtrer()
    Dim sTable As String, sField As String, sSQL As String
    Dim nSQL As Long, nTable As Long, sMsg As String
    sTable = "T_Bouton"                 ' nom de la table
    sField = "[" & Me.cboChamp & "]"    ' nom du champ
    sSQL = ""
    '--- Gestion du combo Forme
    If Nz(Me.cboForme, "") <> "" Then
        sSQL = sSQL & " And Forme = '" & Me.cboForme & "'"
    End If
    '--- Gestion du combo Motif
    If Nz(Me.cboMotif, "") <> "" Then
        sSQL = sSQL & " And Motif = '" & Me.cboMotif & "'"
    End If
    '--- Gestion du combo Couleur
    If Nz(Me.cboCouleur, "") <> "" Then
        sSQL = sSQL & " And Couleur = '" & Me.cboCouleur & "'"
    End If
    '--- Gestion du combo Texte central
    If Nz(Me.cboTit_Centrale, "") <> "" Then
        sSQL = sSQL & " And Tit_Centrale = '" & Me.cboTit_Centrale & "'"
    End If
    '--- Gestion du combo Titulature
    If Nz(Me.cboTit_Perif, "") <> "" Then
        sSQL = sSQL & " And Tit_Perif = '" & Me.cboTit_Perif & "'"
    End If
    '--- Gestion zone texte Description      ---- à adapter
    If Nz(Me.txtCritere, "") <> "" Then
        sSQL = sSQL & " And Decription LIKE '*" & Me.txtDescription & "*')"
    End If
    '---
    If sSQL <> "" Then
        sSQL = Mid(sSQL, 6)
    End If
    nSQL = DCount("*", sTable, sSQL)
    nTable = DCount("*", sTable)
    sMsg = nSQL & " / " & nTable
     '--- Traitement quand le résultat est égal à la totalité de la table des boutons
    If nSQL = nTable Then
        Me.lblNbreEnr.Caption = sMsg & " tous les enregistrements correspondent à vos critères"
    ElseIf nSQL Then 'Affichage quand il n'y a pas de résultat
        Me.lblNbreEnr.Caption = sMsg & " Aucun enregistrement trouvé"
    ElseIf nSQL = 1 Then 'Affichage quand il n'y a qu'un résultat
        Me.lblNbreEnr.Caption = sMsg & " enregistrement correspond à vos critères"
    ElseIf nSQL > 1 Then 'Affichage quand il n'y a plusieurs résultats
        Me.lblNbreEnr.Caption = sMsg & " enregistrements correspondent à vos critères"
    End If
    '--- ne change pas le RowSource mais applique filtre
    '--- lstResultat.RowSource = la table T_Bouton en permanence
    Me.lstResultat.Filter = sSQL
    Me.lstResultat.FilterOn = True
End Sub

L'utilisateur doit éventuellement être informé qu'il peut entrer dans le champ de recherche 'Description' un critère tel que pair*baton et que les accents comptent (é <> e) ou ne compte pas (é=e).

Cordialement.

**Strigbull** · 11/04/2019, 13h06

Bonsoir Eric,

Effectivement, ca a l'air plaisant, je vais essayer ca.
Je vais tout de meme retravailler le cumul des deux avec les choix possibles. Ca pourra me servir a améliorer d'autres de mes BDD.

Je me suis dit que en principe, il doit être possible de filtrer avec la premiere, d'avoir un résultat. Puis, d'utiliser la seconde recherche en choisissant le champ et le texte a chercher (ou autre) et cocher "faire la recherche dans la recherche courante...
J'ai ajouter un espion pour voir quelle est la chaine SQL

example : SELECT * FROM T_Bouton Where Forme = 'Bom AND T_Bouton.[Désignation] Like "*1*"));
J'avais sélectionné Bombé pour la forme, etc.... "bé" de "Bombé" a été rogné!

Autre example : SELECT * FROM T_Bouton Where Forme = 'Plat' And Couleur = 'Do AND T_Bouton.[Description] Like "*1*"));
J'avais sélectionné Plat pour la forme, Doré pour la couleur etc.... "ré" de "Doré" a été rogné, c'est pareil si je choisi un autre champ dans les filtres.
Le dernier texte du "pré" filtre est rogné de 2 lettres dans la chaine SQL
Pour moi, ca vient de cette partie du code:

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
    If Me.Opt_RechCourante And Not Len(Me.lstResultat.RowSource) = 0 Then
 
        Dim ctrl_table As String
        ctrl_table = Left(strTable, Len(strTable) - 1)
        ctrl_table = Right(ctrl_table, Len(ctrl_table) - 1)
 
        'If Not Me.lstResultat.RowSource Like "*FROM [[]" & ctrl_table & "*" Then
            'MsgBox "La recherche précédente ne porte pas sur la même table que la recherche actuelle.", vbExclamation + vbOKOnly, "Erreur"
            'Exit Sub
        'End If
        SQL = Left(Me.lstResultat.RowSource, Len(Me.lstResultat.RowSource) - 3)
        SQL = SQL & " AND " & strCriteria & "));"
    Else
   ' construit la rq sql
        SQL = "SELECT DISTINCTROW " & strTable & ".*"
        SQL = SQL + " FROM " & strTable
        SQL = SQL + " WHERE ((" & strCriteria & "));"

SQL = Left(Me.lstResultat.RowSource, Len(Me.lstResultat.RowSource) - 3) le 3, ici
Je l'ai passé a 1 puis a 0
SELECT * FROM T_Bouton Where Forme = 'Plat' And Motif = 'Numéro' AND T_Bouton.[Description] Like "*1*"));
Ca a l'air bon pour la chaine mais pas de resultat....

Je vais regarder tout ca et te tiendrai au courant.
Merci encore pour ton aide
Zaijian comme on dit ici
Strig

**EricDgn** · 11/04/2019, 13h51

Pour savoir ce qui se passe, poser des Debug.Print à ce niveau:

Code :

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

1
2
3
4
5
6
7
    If Me.Opt_RechCourante And Not Len(Me.lstResultat.RowSource) = 0 Then
        ...
        Debug.Print ">"; Me.lstResultat.RowSource; "<"
        SQL = Left(Me.lstResultat.RowSource, Len(Me.lstResultat.RowSource) - 3)
        Debug.Print ">"; SQL; "<"
        SQL = SQL & " AND " & strCriteria & "));"
        Debug.Print ">"; SQL; "<"

A mon avis c'est effectivement au niveau de .RowSource qu'il y a une erreur d'appréciation.
Cdt

**Strigbull** · 11/04/2019, 15h50

Re Bonsoir

J'ai placé les Debug.Print comme indiqué autour du :
SQL = Left(Me.lstResultat.RowSource, Len(Me.lstResultat.RowSource) - 3)
Résultat avec 3 :
>SELECT * FROM T_Bouton Where Forme = 'Bombé'<
>SELECT * FROM T_Bouton Where Forme = 'Bom AND T_Bouton.[Datation] Like "*1920*"));<
C'est bien rogné

J'ai remplacé le 3 par 0 ca donne

Code :

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

1
2
3
4
Debug.Print ">"; Me.lstResultat.RowSource; "<"
        SQL = Left(Me.lstResultat.RowSource, Len(Me.lstResultat.RowSource) - 0)
        SQL = SQL & " AND " & strCriteria & "));"
Debug.Print ">"; SQL; "<"

Résultat avec 0 :
>SELECT * FROM T_Bouton Where Forme = 'Bombé'<
>SELECT * FROM T_Bouton Where Forme = 'Bombé' AND T_Bouton.[Datation] Like "*1920*"));<
Nom : Capture.JPG
Affichages : 324
Taille : 106,4 Ko

Nom : Capture.JPG
Affichages : 324
Taille : 106,4 Ko

Le SQL semble bon mais il n'y a pas d'affichage du résultat...

Pourtant il y a bien le

Code :

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

1
2
    Me.lstResultat.RowSource = SQL  ' affecte sql a lst_result
    Me.lstResultat.Requery             ' recalcule la liste

après le End If......

Je ne comprend pas cette valeur 3 ... Si j'utilises uniquemement la recherche "par champ" puis la recherche dans la recherche, ca fonctionne (avec 3) pas de résultat avec 0.
Cordialement
Strig

**EricDgn** · 12/04/2019, 00h01

Voyons cela.
Si le premier: Debug.Print ">"; Me.lstResultat.RowSource; "<"
donne comme résultat: >SELECT * FROM T_Bouton Where Forme = 'Bombé'<
cela signifie qu'il y a déjà une condition Where dans la RowSource, et qu'il ne faut rien en retirer, seulement la compléter, et donc ceci devrait être suffisant:

Code :

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

1
2
3
4
5
6
    If Me.Opt_RechCourante And Not Len(Me.lstResultat.RowSource) = 0 Then
        SQL = Me.lstResultat.RowSource & " AND " & strCriteria
    Else
        SQL = "SELECT * FROM " & strTable & " WHERE " & strCriteria   '--- DISTINCTROW utile ?
    End If
    Debug.Print ">"; SQL; "<"

Dans le 2e cas (Else), les )) sont de trop.
Cdt

**Strigbull** · 12/04/2019, 17h18

Bonsoir Eric,

J'ai remplacé cette partie et ca fonctionne très bien en utilisant les deux recherches si on coche " rechercher dans le résultat".

Par exemple:
Nom : Capture.JPG
Affichages : 298
Taille : 164,0 Ko

Nom : Capture.JPG
Affichages : 298
Taille : 164,0 Ko

Le debug.print:
>SELECT * FROM T_Bouton Where Forme = 'Plat' And Motif = 'Faisceau de Licteur' And Couleur = 'Doré' And Tit_Centrale = 'RF' And Tit_Perif = 'ETAT MAJOR DES PLACES' AND T_Bouton.[Dimensions] Like "*27*"<

Le code complet

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Private Sub btnRechercher_Click()
    Dim strField As String, strCriteria As String, strSQL As String
    Dim Criter As Variant
    Dim intTypChamp As Integer
    Dim intOpeChamp As Integer
 
 
    'If IsNull(Me.cboTable) Or IsNull(Me.cboChamp) Then
    If Me.cboChamp = "" Or IsNull(Me.cboChamp) Then
      MsgBox "Vous devez renseigner le champ pour effectuer une recherche !", vbExclamation + vbOKOnly, "Recherche"
      Exit Sub
   End If
 
 
 
    strField = "[" & Me.cboChamp & "]"       ' recupère le nom du champ
 
 
    ' compose le critere de recherche
 
intTypChamp = lf_GetTypeField("T_Bouton", strField)  ' pour trouver le type du champs ...
intOpeChamp = Me.opt_Recherche
 
Select Case intTypChamp
 
       Case dbBoolean                       ' bool
            Select Case intOpeChamp
               Case 1   ' oui
                   strCriteria = "T_Bouton" & "." & strField & "=-1"
               Case 2   ' non
                   strCriteria = "T_Bouton" & "." & strField & "=0"
               Case 3
                   strCriteria = "ISNULL(" & "T_Bouton" & "." & strField & ")"
               Case 4
                   strCriteria = "NOT ISNULL(" & "T_Bouton" & "." & strField & ")"
             End Select
 
        Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp                  ' traite les numeriques
            If Not IsNull(Me.txtCritere) Then   ' si le null n'est pas la valeur à traiter
               strCriteria = Me.txtCritere
               ' traite la virgule si elle existe
               If InStr(1, Me.txtCritere, ",") > 0 Then strCriteria = Replace(Me.txtCritere, ",", ".", 1)
               ' pour les versions antérieure à la 2000
               'If InStr(1, Me.txtcritere, ",") > 0 Then strCriteria = Left(Me.txtcritere, InStr(1, Me.txtcritere, ",") - 1) & "." & Right(Me.txtcritere, InStr(1, Me.txtcritere, ","))
 
               If intTypChamp = dbDate And IsDate(Me.txtCritere) Then strCriteria = "#" & Me.txtCritere & "#"                   ' type champ = date
               ' rajoute les dièses
             End If
 
             Select Case intOpeChamp                    ' numerique, date
                  Case 1 ' =
                       If IsNull(Me.txtCritere) Then
                          strCriteria = "ISNULL(" & "T_Bouton" & "." & strField & ")"
                       Else
                          strCriteria = "T_Bouton" & "." & strField & "=" & strCriteria
                       End If
                  Case 2 ' >=
                       strCriteria = "T_Bouton" & "." & strField & ">=" & strCriteria
 
                  Case 3 ' <=
                       strCriteria = "T_Bouton" & "." & strField & "<=" & strCriteria
 
                  Case 4 '<>
                       If IsNull(Me.txtCritere) Then
                          strCriteria = "NOT ISNULL(" & "T_Bouton" & "." & strField & ")"
                       Else
                          strCriteria = "T_Bouton" & "." & strField & "<>" & strCriteria
                       End If
             End Select
 
       Case dbText, dbMemo, dbChar                      ' texte
            Select Case intOpeChamp
                Case 1 ' strictement egal
                    If IsNull(Me.txtCritere) Then
                       strCriteria = "ISNULL(" & "T_Bouton" & "." & strField & ")"
                    Else
                       strCriteria = "T_Bouton" & "." & strField & " Like """ & Me.txtCritere & """"
                    End If
                Case 2 ' commence par
                    strCriteria = "T_Bouton" & "." & strField & " Like """ & Me.txtCritere & "*"""
                Case 3 ' contient
                    strCriteria = "T_Bouton" & "." & strField & " Like ""*" & Me.txtCritere & "*"""
                Case 4 ' fini par
                    strCriteria = "T_Bouton" & "." & strField & " Like ""*" & Me.txtCritere & """"
                Case 5 ' ne contient pas
                    If IsNull(Me.txtCritere) Then
                       strCriteria = "NOT ISNULL(" & "T_Bouton" & "." & strField & ")"
                    Else
                       strCriteria = "NOT " & "T_Bouton" & "." & strField & " Like ""*" & Me.txtCritere & "*"""
                    End If
            End Select
 
       Case Else
            MsgBox "Cas non prévu."
            Exit Sub
   End Select
 
 
 
    If Me.Opt_RechCourante And Not Len(Me.lstResultat.RowSource) = 0 Then
 
 
Debug.Print ">"; Me.lstResultat.RowSource; "<"
 
        SQL = Me.lstResultat.RowSource & " AND " & strCriteria
    Else
        SQL = "SELECT * FROM " & "T_Bouton" & " WHERE " & strCriteria   '--- DISTINCTROW utile ?
    End If
    Debug.Print ">"; SQL; "<"
 
 
 
 
 
    Me.lstResultat.RowSource = SQL  ' affecte sql a lst_result
    Me.lstResultat.Requery             ' recalcule la liste
 
    Me.txt_ChaineSQL.Value = SQL
 
    'Me.lblNbreEnr.Caption = IIf(Me.lstResultat.ListCount <= 1, 0, Me.lstResultat.ListCount - 1) & "/" & DCount(Me.cboChamp, Me.cboTable)
    'Me.lblNbreEnr.Caption = ""
 
    If Me.lstResultat.ListCount = 0 Or Me.lstResultat.ListCount = 1 Then
        Me.lblNbreEnr.Caption = "Aucun enregistrement trouvé"
    ElseIf Me.lstResultat.ListCount = 2 Then
        Me.lblNbreEnr.Caption = (Me.lstResultat.ListCount - 1) & " " & "enregistrement correspond à votre critère"
    ElseIf Me.lstResultat.ListCount > 2 Then
        Me.lblNbreEnr.Caption = (Me.lstResultat.ListCount - 1) & " " & "enregistrements correspondent à votre critère"
    End If
 
 
End Sub

J'ai essayé de combiner les deux pour pouvoir pré-filtrer et utiliser la recherche sur le champ, en utilisant qu'un bouton...

C'est pas gagné

J’espère y arriver et pouvoir partager le code ici sinon je passerai le fil en Résolu... a moins que tu n'ai une idée lumineuse

Merci pour ton aide
Cordialement
Strig

Formulaire de recherche multicritères et plus [AC-2013]

Access

Discussions similaires

Partager

Partager