Bonjour à tous,

J'ai un formulaire de recherche basé sur le tuto de Cafeine.

Je voudrais générer un Etat à partir des résutlats de ma recherche.

Pour cela, j'ai créer un bouton "cmd_Report1" avec le code suivant :

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
 
 
Private Sub cmd_Report1_Click()
DoCmd.OpenReport "ReportContacts1", acViewPreview, , lf_GetSqlWhere
End Sub
 
 
Function lf_GetSqlWhere()
Dim strWhere As String
Dim strSQL As String
 
    strSQL = Me.lstResults.RowSource
    ' récupère à partir des doubles paranthèses
    strWhere = Right(strSQL, Len(strSQL) - InStrRev(strSQL, "(("))
    ' supprime les caractères inutile de la fin
    strWhere = Left(strWhere, Len(strWhere) - 2)
 
    'on renvoi le résultat
    lf_GetSqlWhere = strWhere
End Function
Le problème est que lorsque je clic sur le bouton, un message d'erreur apparait :

"Vous avez écrit une sous-requête pouvant renvoyer à plus d'un champ sans utiliser le mot réservé EXISTS dans la clause FROM de la requête principale. Révisez l'instruction SELECT de la sous-requête pour obtenir un seul champ".

Au cas ou voici tout le code de mon 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
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
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
Private Sub chkRA_Click()
 
If Me.chkRA Then
    Me.txtRechRA.Visible = False
Else
    Me.txtRechRA.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechRA_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
Private Sub chkDoor_Click()
 
If Me.chkDoor Then
    Me.txtRechDoor.Visible = False
Else
    Me.txtRechDoor.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechDoor_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub chkPre2_Click()
 
If Me.chkPre2 Then
    Me.txtRechPre2.Visible = False
Else
    Me.txtRechPre2.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechPre2_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
Private Sub chkNom2_Click()
 
If Me.chkNom2 Then
    Me.txtRechNom2.Visible = False
Else
    Me.txtRechNom2.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechNom2_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
 
 
Private Sub chkPre1_Click()
 
If Me.chkPre1 Then
    Me.txtRechPre1.Visible = False
Else
    Me.txtRechPre1.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub txtRechPre1_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
Private Sub chkNom1_Click()
 
If Me.chkNom1 Then
    Me.txtRechNom1.Visible = False
Else
    Me.txtRechNom1.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechNom1_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
Private Sub chkLangue_Click()
 
If Me.chkLangue Then
    Me.txtRechLangue.Visible = False
Else
    Me.txtRechLangue.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechLangue_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
Private Sub chkPays_Click()
 
If Me.chkPays Then
    Me.txtRechPays.Visible = False
Else
    Me.txtRechPays.Visible = True
End If
 
RefreshQuery
End Sub
 
 
 
 
Private Sub txtRechPays_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
Private Sub chkVille_Click()
 
If Me.chkVille Then
    Me.txtRechVille.Visible = False
Else
    Me.txtRechVille.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub txtRechVille_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
 
Private Sub chkCP_Click()
 
If Me.chkCP Then
    Me.txtRechCP.Visible = False
Else
    Me.txtRechCP.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub txtRechCP_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
 
 
Private Sub chkRS_Click()
 
If Me.chkRS Then
    Me.txtRechRS.Visible = False
Else
    Me.txtRechRS.Visible = True
End If
 
RefreshQuery
 
End Sub
 
Private Sub txtRechRS_BeforeUpdate(Cancel As Integer)
 
RefreshQuery
 
End Sub
 
 
 
Private Sub chkType_Click()
 
If Me.chkType Then
    Me.cmbRechType.Visible = False
Else
    Me.cmbRechType.Visible = True
End If
 
RefreshQuery
 
End Sub
 
Private Sub cmbRechType_BeforeUpdate(Cancel As Integer)
 
RefreshQuery
 
End Sub
 
 
 
 
 
 
 
 
 
 
 
 
Private Sub Form_Load()
 
Dim ctl As Control
 
For Each ctl In Me.Controls
    Select Case Left(ctl.Name, 3)
        Case "chk"
            ctl.Value = -1
 
        Case "lbl"
            ctl.Caption = "- * - * -"
 
        Case "txt"
            ctl.Visible = False
            ctl.Value = ""
 
        Case "cmb"
            ctl.Visible = False
 
    End Select
Next ctl
 
Me.lstResults.RowSource = "SELECT Contacts.RéfContact, Contacts.Raisonsociale, Contacts.Client2, Contacts.Prospect, Contacts.Pays FROM Contacts;"
Me.lstResults.Requery
 
End Sub
 
 
 
 
 
Private Sub RefreshQuery()
Dim SQL As String
Dim SQLWhere As String
 
SQL = "SELECT Contacts.RéfContact, Contacts.Raisonsociale, Contacts.Client2, Contacts.Prospect, Contacts.Pays FROM Contacts Where Contacts!RéfContact <> 0 "
 
If Not Me.chkRS Then
    SQL = SQL & "And Contacts!Raisonsociale like '*" & Me.txtRechRS & "*' "
End If
 
If Not Me.chkCP Then
    SQL = SQL & "And Contacts!Codepostal like '*" & Me.txtRechCP & "*' "
End If
 
If Not Me.chkVille Then
    SQL = SQL & "And Contacts!Ville like '*" & Me.txtRechVille & "*' "
End If
 
If Not Me.chkPays Then
    SQL = SQL & "And Contacts!Pays like '*" & Me.txtRechPays & "*' "
End If
 
If Not Me.chkLangue Then
    SQL = SQL & "And Contacts!Langue like '*" & Me.txtRechLangue & "*' "
End If
 
If Not Me.chkNom1 Then
    SQL = SQL & "And Contacts!Nom like '*" & Me.txtRechNom1 & "*' "
End If
 
If Not Me.chkPre1 Then
    SQL = SQL & "And Contacts!Prénom like '*" & Me.txtRechPre1 & "*' "
End If
 
If Not Me.chkNom2 Then
    SQL = SQL & "And Contacts!Nom2 like '*" & Me.txtRechNom2 & "*' "
End If
 
If Not Me.chkPre2 Then
    SQL = SQL & "And Contacts!Prénom2 like '*" & Me.txtRechPre2 & "*' "
End If
 
If Not Me.chkDoor Then
    SQL = SQL & "And Contacts!Dooroppener like '*" & Me.txtRechDoor & "*' "
End If
 
If Not Me.chkRA Then
    SQL = SQL & "And Contacts!RéférenceA like '*" & Me.txtRechRA & "*' "
End If
 
 
 
 
 
 
If Not Me.chkType Then
    SQL = SQL & "And Contacts!Client2 = '" & Me.cmbRechType & "' "
End If
 
SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
 
SQL = SQL & ";"
 
Me.lblStats.Caption = DCount("*", "Contacts", SQLWhere) & " / " & DCount("*", "Contacts")
Me.lstResults.RowSource = SQL
Me.lstResults.Requery
 
End Sub
 
 
 
 
 
 
 
 
 
 
Private Sub lstResults_DblClick(Cancel As Integer)
 
DoCmd.OpenForm "Contacts", acNormal, , "[RéfContact] = " & Me.lstResults
 
 
End Sub
 
 
 
 
 
Private Sub cmd_Report1_Click()
DoCmd.OpenReport "ReportContacts1", acViewPreview, , lf_GetSqlWhere
End Sub
 
 
Function lf_GetSqlWhere()
Dim strWhere As String
Dim strSQL As String
 
    strSQL = Me.lstResults.RowSource
    ' récupère à partir des doubles paranthèses
    strWhere = Right(strSQL, Len(strSQL) - InStrRev(strSQL, "(("))
    ' supprime les caractères inutile de la fin
    strWhere = Left(strWhere, Len(strWhere) - 2)
 
    'on renvoi le résultat
    lf_GetSqlWhere = strWhere
End Function
Merci d'avance pour votre aide!!