1 image, plusieurs categories

**POPR26** · 10/07/2012, 09h54

Bonjour,
Je travaille sur une base d'images. J'ai un formulaire avec filtres sur choix multiples. Une table principale (Image), une table Categorie et une table Relation ImageCatehorie car chaque image peut avoir plusieurs catégories.
Actuellement et après beaucoup de recherches, j'arrive à faire mon tri sur plusieurs éléments de ma table Image et une catégorie au choix, mais je n'arrive pas à choisir plusieurs catégories.
J'ai basé mon formulaire sur le code de la base caféine (RECHERCHE MULTI-CRITERES) et j'essaie de l'adapter avec la base FiltrerSurChoixMultiples.mdb mais je n'y arrive toujours pas, il doit me manquer un petit truc.
Je vous joins un copie de mes relations de Tables, et mon code pour mon formulaire de visualisation.
Merci de me donner un peu de temps pour m'aider.

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
 
Option Compare Database
 
Private Sub btnFermer_Click()
DoCmd.Close
End Sub
 
Private Sub chkInfoSup_Click()
If Me.chkInfosup Then
    Me.cmbInfosup.Visible = False
Else
    Me.cmbInfosup.Visible = True
End If
 
RefreshQuery
End Sub
 
 
Private Sub chkContinent_Click()
If Me.chkContinent Then
    Me.cmbContinent.Visible = False
Else
    Me.cmbContinent.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub chkPays_Click()
If Me.chkPays Then
    Me.cmbPays.Visible = False
Else
    Me.cmbPays.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub chkFormat_Click()
If Me.chkFormat Then
    Me.cmbFormat.Visible = False
Else
    Me.cmbFormat.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub chkKeyword_Click()
If Me.chkKeyword Then
    Me.txtKeyword.Visible = False
Else
    Me.txtKeyword.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub chkReference_Click()
If Me.chkReference Then
    Me.cmbReference.Visible = False
Else
    Me.cmbReference.Visible = True
End If
 
RefreshQuery
End Sub
Private Sub chkCategorie_Click()
If Me.chkCategorie Then
    Me.cmbCategorie.Visible = False
Else
    Me.cmbCategorie.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub chkTaille_Click()
If Me.chkTaille Then
    Me.cmbTaille.Visible = False
Else
    Me.cmbTaille.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub chkTitre_Click()
If Me.chkTitre Then
    Me.txtTitre.Visible = False
Else
    Me.txtTitre.Visible = True
End If
 
RefreshQuery
End Sub
 
Private Sub Affichage_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub Affichage_AfterUpdate()
RefreshQuery
End Sub
 
Private Sub cmbInfoSup_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub cmbCategorie_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub cmbContinent_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub cmbPays_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub cmbFormat_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub cmbReference_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub cmbTaille_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub lstResults_DblClick(Cancel As Integer)
   DoCmd.OpenForm "SF_VISU_Info", acNormal, , "[IdImage] = " & Me.lstResults
End Sub
 
Private Sub txtKeyword_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
 
Private Sub txtTitre_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 DISTINCT * FROM RequeteSourceRecherche "
Me.lstResults.Requery
 
End Sub
 
Private Sub RefreshQuery()
    Dim SQL As String
    Dim SQLWhere As String
 
On Error Resume Next
 
If Me.chkCategorie = -1 Then
 
        SQL = "SELECT DISTINCT * FROM RequeteSourceRecherche Where T_Image!IdImage <> 0"
 
    If Not Me.chkReference Then
         SQL = SQL & " And T_Image!Reference = '" & Me.cmbReference & "' "
    End If
    If Not Me.chkTitre Then
         SQL = SQL & " And T_Image!Titre like '*" & Me.txtTitre & "*' "
    End If
    If Not Me.chkContinent Then
         SQL = SQL & " And T_Image.Continent = '" & Me.cmbContinent & "' "
    End If
    If Not Me.chkPays Then
         SQL = SQL & " And T_Image!Pays = '" & Me.cmbPays & "' "
    End If
    If Not Me.chkKeyword Then
         SQL = SQL & " And T_Image!Keyword like '*" & Me.txtKeyword & "*' "
    End If
    If Not Me.chkFormat Then
         SQL = SQL & " And T_Image!Format = '" & Me.cmbFormat & "' "
    End If
    If Not Me.chkTaille Then
         SQL = SQL & " And T_Image!Taille = '" & Me.cmbTaille & "' "
    End If
    If Not Me.chkInfosup Then
         SQL = SQL & " And T_Image!Infosup = '" & Me.cmbInfosup & "' "
    End If
 
    SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
 
    'SQL = SQL & ";"
 
    If Me.Affichage = "Reference" Then
    SQL = SQL & "ORDER BY T_Image.IdImage;"
    Else
    SQL = SQL & "ORDER BY T_Image.Titre;"
    End If
 
    Me.lblStats.Caption = DCount("*", "RequeteSourceRecherche", SQLWhere) & " / " & DCount("*", "T_Image")
 
    Me.lstResults.RowSource = SQL
    Me.lstResults.Requery
    Me.Affichage.Requery
 
 
Else
 
 
    SQL = "SELECT DISTINCT * FROM RequeteSourceRechercheCategorie Where T_Image!IdImage <> 0"
 
    If Not Me.chkReference Then
        SQL = SQL & " And T_Image!Reference = '" & Me.cmbReference & "' "
    End If
    If Not Me.chkTitre Then
        SQL = SQL & " And T_Image!Titre like '*" & Me.txtTitre & "*' "
    End If
    If Not Me.chkContinent Then
        SQL = SQL & " And T_Image.Continent = '" & Me.cmbContinent & "' "
    End If
    If Not Me.chkPays Then
        SQL = SQL & " And T_Image!Pays = '" & Me.cmbPays & "' "
    End If
    If Not Me.chkKeyword Then
        SQL = SQL & " And T_Image!Keyword like '*" & Me.txtKeyword & "*' "
    End If
 
 
 
    If Not Me.chkCategorie Then
 
    ' code a tester
    ' ---------------------------------------------------------------
    Dim l_strIn As String
    'Dim l_strSql As String
    Dim l_intItem As Integer
    ' parcours de la liste pour récupérer le code sélectionné
    For l_intItem = 0 To Me.cmbCategorie.ListCount - 1
        If Me.cmbCategorie.Selected(l_intItem) = True Then
            ' Création du critère : IN(val1, val2, ...)
            l_strIn = l_strIn & Me.cmbCategorie.Column(0, l_intItem) & ","
        End If
    Next
    ' Suppression du dernier caractère de la chaine critère
        If Len(l_strIn) = 0 Then
            SQL = ""
        Else
            l_strIn = Left(l_strIn, Len(l_strIn) - 1)
            SQL = SQL & "And T_REL_ImageCategorie.Categorie = '" & l_strIn & "' "
       '-----------------------------------------------------------------
        End If
    End If
 
 
    If Not Me.chkFormat Then
        SQL = SQL & " And T_Image!Format = '" & Me.cmbFormat & "' "
    End If
    If Not Me.chkTaille Then
        SQL = SQL & " And T_Image!Taille = '" & Me.cmbTaille & "' "
    End If
    If Not Me.chkInfosup Then
        SQL = SQL & " And T_Image!Infosup = '" & Me.cmbInfosup & "' "
    End If
 
    SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
 
    If Me.Affichage = "reference" Then
    SQL = SQL & "ORDER BY T_Image.IdImage;"
    Else
    SQL = SQL & "ORDER BY T_Image.Titre;"
    End If
 
    Me.lblStats.Caption = DCount("*", "RequeteSourceRechercheCategorie", SQLWhere) & " / " & DCount("*", "T_Image")
 
    Me.lstResults.RowSource = SQL
    Me.lstResults.Requery
    Me.Affichage.Requery
 
End If
 
End Sub
 
Private Sub lstResults_Click()
    Dim DossierbanqueImage As String
 
DossierbanqueImage = DLookup("[DossierImage]", "T_Parametre")
 
'Affichage de l'image par son chemin
Me.Image.Picture = DossierbanqueImage & "bmp\" & "PO" & IIf(Me.lstResults.Value < 10, "0000", IIf(Me.lstResults.Value < 100, "000", IIf(Me.lstResults.Value < 1000, "00", IIf(Me.lstResults.Value < 10000, "0", "")))) & Me.lstResults.Value & ".bmp"
 
End Sub

**POPR26** · 13/07/2012, 10h41

Problème résolu sur la discussion formulaire-resultat :

http://www.developpez.net/forums/d12...aire-resultat/

1 image, plusieurs categories [AC-2007]

Access

Discussions similaires

Partager

Partager