Générer un Etat à partir du résultat d'une recherche (tuto Cafeine)

**hassan1234** · 07/08/2008, 11h45

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

**Lou Pitchoun** · 07/08/2008, 15h38

Salut,

La première chose qui aurait du te frapper c'est que ta fonction ne te retourne absolument rien.

Déclare là comme suit :

Code :

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

Function lf_GetSqlWhere() As String

**hassan1234** · 07/08/2008, 15h45

Salut,

Merci pour ta réponse.

Effectivement, cela m'a echappé

Par contre, j'ai toujours une erreur d'execution 3306 et le debug me renvoie à ca :

Code :

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

1
2
3
4
5

Private Sub cmd_Report1_Click()
DoCmd.OpenReport "ReportContacts1", acViewPreview, , lf_GetSqlWhere
End Sub

**Lou Pitchoun** · 07/08/2008, 16h03

Il faut que ta fonction te renvoi quelque chose du genre :
"[MonChamp] = mavaleur" ( mavaleur encadré par des " ou ' en fonction du type de donnée : texte ou numérique.)

**hassan1234** · 07/08/2008, 16h26

Salut,

Voici mon code modifié :

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
 
Private Sub cmd_Report1_Click()
 
Dim rst As Recordset
    Dim strCriteria As String
 
    Set rst = CurrentDb.OpenRecordset("tbl_TempLstRpt", dbOpenSnapshot)
    ' recherche les informations de la table
    rst.FindFirst ("Table='" & Etat & "'")
 
    If rst.NoMatch Then     ' non trouvé
        MsgBox "Cette table ne possède pas d'état. " & _
               "Veuillez renseigner la table des paramètres.", _
               vbCritical + vbOKOnly, "formulaire de Recherche"
        Exit Sub
Else
DoCmd.OpenReport "Etat", acViewPreview, , lf_GetSqlWhere
End If
End Sub

tbl_TempLstRpt est une table ou il y a deux champs : Table (avec comme entrée Contacts (la table qui renseigne la recherche) et Etat (ReportContacts1 qui renvoie à mon Etat).

Or, cela ne marche toujours pas, il y a un message d'erreur :

"Cette table ne possède pas d'Etat. Weuillez renseigner la table des paramètres".

**hassan1234** · 08/08/2008, 09h17

Salut,

Quelqu'un aurait-il une piste à suivre??

Merci d'avance

Générer un Etat à partir du résultat d'une recherche (tuto Cafeine)

VBA Access

Vue hybride

Discussions similaires

Partager

Partager