Petite question sur le formulaire de recherche de Loufab

**Kevin80** · 15/04/2011, 13h50

Voilà je tiens tout d'abord à te remercier pour ces tutos sur le formulaire de recherche qui est complet et qui fonctionne très bien.

Cependant je n'arrive pas à rechercher une information entre telle date et telle date.

Je m'explique quand je choisis une première date, il y a un problème avec le groupe d'options car si je choisis " être inférieur <=" ou les autres les données qui me sont renvoyées ne sont pas correct.

Auriez vous la solution svp?

Sachant que je n'ai pas mis en place la solution pour voir le SQL, ni la gestion du NULL, ni la gestion du AND/OR.

Merci d'avance Cordialement Kévin

**loufab** · 15/04/2011, 23h10

Bonjour et merci !

Le test 2 et 3 sont inversés.

Soit inverser les 2 tests soit les 2 étiquettes.

Pour faire une recherche entre 2 dates :
faire la 1ère recherche avec les dates >= puis cocher le bouton d'option "effecuter une nouvelle recherche..." puis faire la 2ème avec les dates <=.

Cordialement,

**Kevin80** · 16/04/2011, 11h40

Ok merci pour ta réponse mais quand tu regardes sur le résultat obtenu on voit bien qu'il y a des dates au dessus et en dessous de ce qui est demandé c'est pour ceci que ca me parait bizarre.

Tu penses que l'erreur est que l'inversion des 2?

**loufab** · 17/04/2011, 20h40

J'ai regardé le code et il me semble bien que cela vient de là.

**Kevin80** · 18/04/2011, 08h00

A quel endroit dis tu qu'il y a l'erreur car j'ai cherché dans mon code et je ne trouve pas de soucis.
PAr contre le "égal =" fonctionne que de temps en temps si je recherche une date dès moment il me l'affiche et des moments non, serais tu pourquoi?

Merci d'avance pour tes réponses.

Cordialement Kévin

**loufab** · 18/04/2011, 11h35

Tu as des noms de tables et de champs avec des espaces ?

**Kevin80** · 18/04/2011, 13h37

Non mes noms de champs et de tables sont sans espace ou il y a des underscore entre deux. Pourquoi?

**loufab** · 18/04/2011, 14h36

Avec des espaces il faut utiliser les crochets (cf 2ème partie 1er chapitre).
Le seul moyen est de regarder ce qu'il génère.

**Kevin80** · 18/04/2011, 16h02

J'ai tout vérifier, mes champs, mes tables , mes requêtes et tout est ok !!!
Je vais saisir de nouvelles données et refaire les tests dans très peu de temps et je vous tiens au courant des conclusions.

MErci encore

**Kevin80** · 19/04/2011, 13h08

J'ai toujours le même problème pour rechercher de date à date.
Le type du champ doit bien etre une Date,abrégé ???
Voici le code est il correcte:

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
     If intTypChamp = dbDate And IsDate(Me.txt_critere) Then strCriteria = "#" _
               & Me.txt_critere & "#"                  ' type champ = date
            ' rajoute les dièses
 
            If Not IsNull(Me.txt_critere) Then
               Select Case intOpeChamp                    ' numerique, date
                   Case 1 ' =
                        strCriteria = strTable & "." & strField & "=" & strCriteria
 
                   Case 2 ' >=
                        strCriteria = strTable & "." & strField & ">=" & strCriteria
 
                   Case 3 ' <=
                        strCriteria = strTable & "." & strField & "<=" & strCriteria
 
                   Case 4 '<>
                        strCriteria = strTable & "." & strField & "<>" & strCriteria
               End Select
            End If

**Kevin80** · 19/04/2011, 13h10

Voici le code complet de mon bouton recherche:

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
Private Sub cmd_recherche_Click()
Dim strTable As String, strField As String, strCriteria As String, strSql As String
Dim Criter As Variant
If IsNull(Me.cbo_table) Or IsNull(Me.cbo_champ) Then
      MsgBox "Vous devez renseigner la table et le champ pour effectuer une recherche !", vbExclamation + vbOKOnly, "Recherche"
      Exit Sub
   End If
Dim intTypChamp As Integer
Dim intOpeChamp As Integer
 
    strTable = Me.cbo_table         ' recupère le nom de la table
    strField = Me.cbo_champ         ' 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
            If intOpeChamp = 1 Then          ' oui
               strCriteria = strTable & "." & strField & "=-1"
            ElseIf intOpeChamp = 2 Then      ' non
               strCriteria = strTable & "." & strField & "=0"
            Else
               strCriteria = strTable & "." & strField & "=Null"
            End If
 
       Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp
       ' traite les numeriques
            strCriteria = Me.txt_critere
            ' traite la virgule si elle existe
            If InStr(1, Me.txt_critere, ",") > 0 Then strCriteria = Replace(Me.txt_critere, ",", ".", 1)
            ' pour les versions antérieure à la 2000
            'If InStr(1, Me.txt_critere, ",") > 0 Then _
            ' strCriteria = Left(Me.txt_critere, InStr(1, Me.txt_critere, ",") - 1) _
            ' & "." & Right(Me.txt_critere, InStr(1, Me.txt_critere, ","))
 
            If intTypChamp = dbDate And IsDate(Me.txt_critere) Then strCriteria = "#" _
               & Me.txt_critere & "#"                  ' type champ = date
            ' rajoute les dièses
 
            If Not IsNull(Me.txt_critere) Then
               Select Case intOpeChamp                    ' numerique, date
                   Case 1 ' =
                        strCriteria = strTable & "." & strField & "=" & strCriteria
 
                   Case 2 ' >=
                        strCriteria = strTable & "." & strField & ">=" & strCriteria
 
                   Case 3 ' <=
                        strCriteria = strTable & "." & strField & "<=" & strCriteria
 
                   Case 4 '<>
                        strCriteria = strTable & "." & strField & "<>" & strCriteria
               End Select
            End If
 
       Case dbText, dbMemo, dbChar                      ' texte
            Select Case intOpeChamp
                  Case 1 ' strictement egal
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & """"
                  Case 2 ' commence par
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & "*"""
                  Case 3 ' contient
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"""
                  Case 4 ' fini par
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & """"
                  Case 5 ' ne contient pas
                       strCriteria = "NOT (" & strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"")"
           End Select
    Case Else
            MsgBox "Cas non prévu."
            Exit Sub
    End Select
 
 ' debut de selection des champs
    Dim strChamps As String
    Dim entCurrLigne As Integer
    For entCurrLigne = 0 To Me.lst_champs.ListCount - 1
        If Me.lst_champs.Selected(entCurrLigne) Then
            strChamps = strChamps & "[" & Me.lst_champs.Column(0, entCurrLigne) & "], "
        End If
    Next entCurrLigne
 
    If Len(strChamps) = 0 Then
       strChamps = strTable & ".*"
    Else
       strChamps = Left(strChamps, Len(strChamps) - 2)
    End If
' fin de selection des champs
 
    ' construit la requête sql
   If Me.Opt_RechCourante And Not Len(Me.lst_resultat.RowSource) = 0 Then
   If Not Me.lst_resultat.RowSource Like "*FROM " & strTable & "*" 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
   strSql = Left(Me.lst_resultat.RowSource, Len(Me.lst_resultat.RowSource) - 3)
   strSql = strSql & " AND " & strCriteria & "));"
Else
   ' construit la rq sql
   strSql = "SELECT DISTINCTROW " & strChamps
   strSql = strSql + " FROM " & strTable
   strSql = strSql + " WHERE ((" & strCriteria & "));"
End If
 
    Me.lst_resultat.RowSource = strSql  ' affecte sql a lst_Resultat
    Me.lst_resultat.Requery             ' recalcule la liste
 
    Me.lbl_nbRecord.Caption = IIf(Me.lst_resultat.ListCount _
        <= 1, 0, Me.lst_resultat.ListCount - 1) & "/" & _
        DCount(Me.cbo_champ, Me.cbo_table)
End Sub

**loufab** · 19/04/2011, 15h37

Il y a une inversion et une correction (facultative)

Elles sont repérées par 'ICI CORRECTION

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
Private Sub cmd_recherche_Click()
Dim strTable As String, strField As String, strCriteria As String, strSql As String
Dim Criter As Variant
If IsNull(Me.cbo_table) Or IsNull(Me.cbo_champ) Then
      MsgBox "Vous devez renseigner la table et le champ pour effectuer une recherche !", vbExclamation + vbOKOnly, "Recherche"
      Exit Sub
   End If
Dim intTypChamp As Integer
Dim intOpeChamp As Integer
'ICI CORRECTION----------
    strTable = "[" & Me.cbo_table & "]"         ' recupère le nom de la table
    strField = "[" & Me.cbo_champ & "]"         ' 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
            If intOpeChamp = 1 Then          ' oui
               strCriteria = strTable & "." & strField & "=-1"
            ElseIf intOpeChamp = 2 Then      ' non
               strCriteria = strTable & "." & strField & "=0"
            Else
               strCriteria = strTable & "." & strField & "=Null"
            End If
 
       Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp
       ' traite les numeriques
            strCriteria = Me.txt_critere
            ' traite la virgule si elle existe
            If InStr(1, Me.txt_critere, ",") > 0 Then strCriteria = Replace(Me.txt_critere, ",", ".", 1)
            ' pour les versions antérieure à la 2000
            'If InStr(1, Me.txt_critere, ",") > 0 Then _
            ' strCriteria = Left(Me.txt_critere, InStr(1, Me.txt_critere, ",") - 1) _
            ' & "." & Right(Me.txt_critere, InStr(1, Me.txt_critere, ","))
 
            If intTypChamp = dbDate And IsDate(Me.txt_critere) Then strCriteria = "#" _
               & Me.txt_critere & "#"                  ' type champ = date
            ' rajoute les dièses
 
            If Not IsNull(Me.txt_critere) Then
               Select Case intOpeChamp                    ' numerique, date
                   Case 1 ' =
                        strCriteria = strTable & "." & strField & "=" & strCriteria
 'ICI CORRECTION --------------------------------------                               
                   Case 2 ' >=
                        strCriteria = strTable & "." & strField & "<=" & strCriteria
 
                   Case 3 ' <=
                        strCriteria = strTable & "." & strField & ">=" & strCriteria
'------------------------------------------------------                                
                   Case 4 '<>
                        strCriteria = strTable & "." & strField & "<>" & strCriteria
               End Select
            End If
 
       Case dbText, dbMemo, dbChar                      ' texte
            Select Case intOpeChamp
                  Case 1 ' strictement egal
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & """"
                  Case 2 ' commence par
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & "*"""
                  Case 3 ' contient
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"""
                  Case 4 ' fini par
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & """"
                  Case 5 ' ne contient pas
                       strCriteria = "NOT (" & strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"")"
           End Select
    Case Else
            MsgBox "Cas non prévu."
            Exit Sub
    End Select
 
 ' debut de selection des champs
    Dim strChamps As String
    Dim entCurrLigne As Integer
    For entCurrLigne = 0 To Me.lst_champs.ListCount - 1
        If Me.lst_champs.Selected(entCurrLigne) Then
            strChamps = strChamps & "[" & Me.lst_champs.Column(0, entCurrLigne) & "], "
        End If
    Next entCurrLigne
 
    If Len(strChamps) = 0 Then
       strChamps = strTable & ".*"
    Else
       strChamps = Left(strChamps, Len(strChamps) - 2)
    End If
' fin de selection des champs
 
    ' construit la requête sql
   If Me.Opt_RechCourante And Not Len(Me.lst_resultat.RowSource) = 0 Then
   If Not Me.lst_resultat.RowSource Like "*FROM " & strTable & "*" 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
   strSql = Left(Me.lst_resultat.RowSource, Len(Me.lst_resultat.RowSource) - 3)
   strSql = strSql & " AND " & strCriteria & "));"
Else
   ' construit la rq sql
   strSql = "SELECT DISTINCTROW " & strChamps
   strSql = strSql + " FROM " & strTable
   strSql = strSql + " WHERE ((" & strCriteria & "));"
End If
 
    Me.lst_resultat.RowSource = strSql  ' affecte sql a lst_Resultat
    Me.lst_resultat.Requery             ' recalcule la liste
 
    Me.lbl_nbRecord.Caption = IIf(Me.lst_resultat.ListCount _
        <= 1, 0, Me.lst_resultat.ListCount - 1) & "/" & _
        DCount(Me.cbo_champ, Me.cbo_table)
End Sub

**Kevin80** · 20/04/2011, 08h01

Malgrè les changements rien ne se fait c'est bizarre.
Je rencontre un soucis quand j'essaye de rajouter la référence :

Microsoft DAO 3.6 Object Library

Il me met un message d'erreur :

Nom du module, de projet ou de bibliothèque d'objets déjà utilisé.

Le problème viendrait il de ceci? Car je n'arrive pas à rajouter le DAO.

Merci d'avance Kévin

**Kevin80** · 20/04/2011, 08h08

Voici le résultat avec les changements que vous m'avez proposé!

"Etre egale =" ne fonctionne pas quand je marque le "12/04/2011" alors qu'il y en a plusieurs.

"Etre supérieur ou egal >=" ne fonctionne pas non plus il me sort toutes les dates peut importe la saisie que j'ai mise.

"Etre inférieur ou egal <=" ne fonctionne pas du tout

"Etre different <>" ne fonctionne pas non plus.

MErci d'avance pour ton aide. Je suis dans l'impasse et la principale fonctionnalité et utilisation de mon système de recherche doit se faire sur des dates c'est pour ceci que je suis bloqué.

**loufab** · 20/04/2011, 08h21

DAO est déjà inclus dans les références.

mets un point d'arrêt sur la lign 110 et dans la fenêtre exécution tape

Code :

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

? strSql

Poste le code SQL résultant.

**Kevin80** · 20/04/2011, 09h35

J'ai mis un point d'arret mais quand je veux exécuter "? strSql " sa fait rien.

Voici tous le code de ma recherche:

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
Option Compare Database
 
Private Sub cbo_champ_AfterUpdate()
If IsNull(Me.cbo_table) Or IsNull(Me.cbo_champ) Then
   Exit Sub     ' l'un des champs est vide
End If
 
' initialise les étiquettes de l'opérateur
Me.lbl_Etiq1.Visible = True
Me.lbl_Etiq2.Visible = True
Me.lbl_Etiq3.Visible = True
Me.lbl_Etiq4.Visible = True
Me.lbl_Etiq5.Visible = True
Me.opt_Ope1.Visible = True
Me.opt_Ope2.Visible = True
Me.opt_Ope3.Visible = True
Me.opt_Ope4.Visible = True
Me.opt_Ope5.Visible = True
Me.txt_critere.Visible = True
 
 
Select Case lf_GetTypeField(Me.cbo_table, Me.cbo_champ)  ' pour trouver le type du champs
 
    Case Is = dbBoolean     ' Booléen
         Me.lbl_TypeChamp.Caption = "Oui/Non"
         Me.lbl_Etiq1.Caption = "Oui"
         Me.lbl_Etiq2.Caption = "Non"
         Me.lbl_Etiq3.Visible = False   ' cache car inusité dans ce cas
         Me.lbl_Etiq4.Visible = False   ' idem
         Me.lbl_Etiq5.Visible = False   ' idem
         Me.opt_Ope3.Visible = False
         Me.opt_Ope4.Visible = False
         Me.opt_Ope5.Visible = False
         Me.txt_critere.Visible = False   ' pas de critere
 
    Case dbByte To dbBinary, dbLongBinary, dbGUID To dbVarBinary, dbNumeric To dbTimeStamp
    ' Numériques / date
         Me.lbl_TypeChamp.Caption = "Numérique"
         Me.lbl_Etiq1.Caption = "Etre égale ="
         Me.lbl_Etiq2.Caption = "Etre inférieure <="
         Me.lbl_Etiq3.Caption = "Etre supérieure >="
         Me.lbl_Etiq4.Caption = "Etre différente <>"
         Me.lbl_Etiq5.Visible = False
         Me.opt_Ope5.Visible = False
 
    Case dbText, dbMemo, dbChar ' texte / mémo
         Me.lbl_TypeChamp.Caption = "Texte"
         Me.lbl_Etiq1.Caption = "Etre strictement identique"
         Me.lbl_Etiq2.Caption = "Commencer par la valeur"
         Me.lbl_Etiq3.Caption = "Contenir la valeur"
         Me.lbl_Etiq4.Caption = "Finir par la valeur"
         Me.lbl_Etiq5.Caption = "Pas contenir la valeur"
 
     Case Else
         Me.lbl_TypeChamp.Caption = "Cas non prévu " & lf_GetTypeField(Me.cbo_table, Me.cbo_champ)
 
End Select
End Sub
 
Private Sub cbo_table_AfterUpdate()
Me.cbo_champ.RowSource = Me.cbo_table.Value
Me.cbo_champ.Requery
Me.lst_champs.RowSource = Me.cbo_table.Value
Me.lst_champs.Requery
End Sub
 
Private Sub cmd_recherche_Click()
Dim strTable As String, strField As String, strCriteria As String, strSql As String
Dim Criter As Variant
If IsNull(Me.cbo_table) Or IsNull(Me.cbo_champ) Then
      MsgBox "Vous devez renseigner la table et le champ pour effectuer une recherche !", vbExclamation + vbOKOnly, "Recherche"
      Exit Sub
   End If
Dim intTypChamp As Integer
Dim intOpeChamp As Integer
'ICI CORRECTION----------
    strTable = "[" & Me.cbo_table & "]"         ' recupère le nom de la table
    strField = "[" & Me.cbo_champ & "]"         ' 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
            If intOpeChamp = 1 Then          ' oui
               strCriteria = strTable & "." & strField & "=-1"
            ElseIf intOpeChamp = 2 Then      ' non
               strCriteria = strTable & "." & strField & "=0"
            Else
               strCriteria = strTable & "." & strField & "=Null"
            End If
 
       Case dbByte To dbBinary, dbLongBinary, dbBigInt To dbVarBinary, dbNumeric To dbTimeStamp
       ' traite les numeriques
            strCriteria = Me.txt_critere
            ' traite la virgule si elle existe
            If InStr(1, Me.txt_critere, ",") > 0 Then strCriteria = Replace(Me.txt_critere, ",", ".", 1)
            ' pour les versions antérieure à la 2000
            'If InStr(1, Me.txt_critere, ",") > 0 Then _
            ' strCriteria = Left(Me.txt_critere, InStr(1, Me.txt_critere, ",") - 1) _
            ' & "." & Right(Me.txt_critere, InStr(1, Me.txt_critere, ","))
 
            If intTypChamp = dbDate And IsDate(Me.txt_critere) Then strCriteria = "#" _
               & Me.txt_critere & "#"                  ' type champ = date
            ' rajoute les dièses
 
            If Not IsNull(Me.txt_critere) Then
               Select Case intOpeChamp                    ' numerique, date
                   Case 1 ' =
                        strCriteria = strTable & "." & strField & "=" & strCriteria
 'ICI CORRECTION --------------------------------------
                   Case 2 ' >=
                        strCriteria = strTable & "." & strField & "<=" & strCriteria
 
                   Case 3 ' <=
                        strCriteria = strTable & "." & strField & ">=" & strCriteria
'------------------------------------------------------
                   Case 4 '<>
                        strCriteria = strTable & "." & strField & "<>" & strCriteria
               End Select
            End If
 
       Case dbText, dbMemo, dbChar                      ' texte
            Select Case intOpeChamp
                  Case 1 ' strictement egal
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & """"
                  Case 2 ' commence par
                       strCriteria = strTable & "." & strField & " Like """ & Me.txt_critere & "*"""
                  Case 3 ' contient
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"""
                  Case 4 ' fini par
                       strCriteria = strTable & "." & strField & " Like ""*" & Me.txt_critere & """"
                  Case 5 ' ne contient pas
                       strCriteria = "NOT (" & strTable & "." & strField & " Like ""*" & Me.txt_critere & "*"")"
           End Select
    Case Else
            MsgBox "Cas non prévu."
            Exit Sub
    End Select
 
 ' debut de selection des champs
    Dim strChamps As String
    Dim entCurrLigne As Integer
    For entCurrLigne = 0 To Me.lst_champs.ListCount - 1
        If Me.lst_champs.Selected(entCurrLigne) Then
            strChamps = strChamps & "[" & Me.lst_champs.Column(0, entCurrLigne) & "], "
        End If
    Next entCurrLigne
 
    If Len(strChamps) = 0 Then
       strChamps = strTable & ".*"
    Else
       strChamps = Left(strChamps, Len(strChamps) - 2)
    End If
' fin de selection des champs
 
    ' construit la requête sql
   If Me.Opt_RechCourante And Not Len(Me.lst_resultat.RowSource) = 0 Then
   If Not Me.lst_resultat.RowSource Like "*FROM " & strTable & "*" 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
   strSql = Left(Me.lst_resultat.RowSource, Len(Me.lst_resultat.RowSource) - 3)
   strSql = strSql & " AND " & strCriteria & "));"
Else
   ' construit la rq sql
   strSql = "SELECT DISTINCTROW " & strChamps
   strSql = strSql + " FROM " & strTable
   strSql = strSql + " WHERE ((" & strCriteria & "));"
End If
 
    Me.lst_resultat.RowSource = strSql  ' affecte sql a lst_Resultat
    Me.lst_resultat.Requery             ' recalcule la liste
 
    Me.lbl_nbRecord.Caption = IIf(Me.lst_resultat.ListCount _
        <= 1, 0, Me.lst_resultat.ListCount - 1) & "/" & _
        DCount(Me.cbo_champ, Me.cbo_table)
End Sub
 
Private Sub Form_Open(Cancel As Integer)
' crée la liste des tables
If lf_GetTableList() = 0 Then
   MsgBox "Pas de tables dans cette application .", vbInformation + vbOKOnly, "Erreur"
   Cancel = True
End If
End Sub
 
Private Sub lst_resultat_DblClick(Cancel As Integer)
Dim rst As Recordset
Dim strCriteria As String
 
Set rst = CurrentDb.OpenRecordset("tbl_TempLstFrm", dbOpenSnapshot)
' recherche les informations de la table
rst.FindFirst ("Table='" & Me.cbo_table & "'")
 
If rst.NoMatch Then     ' non trouvé
   MsgBox "Cette table ne possède pas de formulaire. Veuillez renseigner la table des paramètres.", _
          vbCritical + vbOKOnly, "formulaire de Recherche"
   Exit Sub
Else                    ' trouvé
   If lf_GetTypeField(Me.cbo_table, rst.Fields("Champ")) = dbText Then  'la clef est Texte
      strCriteria = rst.Fields("Champ") & "='" & Me.lst_resultat & "'"
   Else                                                                 'la clef est numérique
      strCriteria = rst.Fields("Champ") & "=" & Me.lst_resultat
   End If
   DoCmd.OpenForm rst.Fields("Formulaire"), acNormal, , strCriteria
End If
End Sub

Voici le module de ma recherche:

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
Option Compare Database
 
Function lf_GetTypeField(lfNameTbl As String, lfNameFld As String)
' Renvoie le numéro du type du champ
'lfNameTbl = nom de la table
'lfNameFld = nom du champ
 
    Dim dbs As Database             ' Objet de la base
    Dim tbl As TableDef             ' Objet de définition de table
 
    Set dbs = CurrentDb             ' ouvre la base courante
    Set tbl = dbs.TableDefs(lfNameTbl)  ' ouvre la définition table
 
    lf_GetTypeField = tbl.Fields(lfNameFld).Type  ' renvoie le type de champ
 
    Set tbl = Nothing               ' libération des objets
    Set dbs = Nothing
 
End Function
 
 
 Function lf_GetTableList()
' renseigne la table tbl_TemplstTbl
 
Dim qrs As TableDefs
Dim rst As Recordset
 
Dim strSql As String
Dim i As Integer, j As Integer
 
' efface la table temporaire
DoCmd.SetWarnings False
strSql = "Delete tbl_TempLstTbl.*"
strSql = strSql + " FROM tbl_TempLstTbl;"
DoCmd.RunSQL strSql
 
' rempli    la table temporaire
Set qrs = CurrentDb.TableDefs
Set rst = CurrentDb.OpenRecordset("tbl_TempLstTbl")
 
For i = 0 To qrs.Count - 1
    ' ecarte les tables temp et systeme
    If Not (qrs(i).Name Like "*Temp*") And Not (qrs(i).Name Like "Msys*") And _
       Not (qrs(i).Name Like "*tmp*") Then
       rst.AddNew
       rst.Fields(0) = qrs(i).Name
       rst.Update
    End If
Next
lf_GetTableList = rst.RecordCount
 
rst.Close
Set rst = Nothing
Set qrs = Nothing
DoCmd.SetWarnings True
End Function

**Kevin80** · 20/04/2011, 10h07

Il doit y avoir aussi un conflit entre les tables car quand je fais une première recherche dans une table et que je veux approfondir ma recherche dans la même table et le même champs mais pour une date différente il me met le message d'erreur comme quoi je ne suis pas dans la meme table.

**Kevin80** · 20/04/2011, 14h24

Je suis dessus depuis ce matin et je fais pleins de tests.
Voici le résultat d'un de mes tests:
Lorsque je mets cette modification que vous m'aviez apporté:

Code :

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

1
2
3
4
'ICI CORRECTION----------
    strTable = "[" & Me.cbo_table & "]"         ' recupère le nom de la table
    strField = "[" & Me.cbo_champ & "]"         ' recupère le nom du champ
'------------------------

Je ne peux pas faire de recherche approfondi car il met le message d'erreur comme quoi que ma premiere recherche n'est pas dans la meme table que celle ci par contre quand je laisse mon code comme avant sans les guillemets et les crochets ca marche très bien.

Cependant mon système de recherche de date à date fonctionne bien dans une table (ma table principale) mais quand je veux le faire dans une autre table les "<=" et >=" et "=" et "<>" ne fonctionne pas, je comprend pas.

MErci d'avance Kévin