[AC-2007] Rechere multi_critères améliorée

yannprada · 19/04/2011, 11h35

Bonjour,

J'ai pas mal bossé sur ce code. Ce n'est peut-être pas des améliorations mais de nouvelles idées pour certaines sélections et tris. Je le partage pour en faire profiter tout le monde.

Bonne lecture

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
Option Compare Database
'Ce code est très peu commenté.
'Ceci s'explique par le fait qu'il ai été construit à partir de celui proposé ici :
'   http://cafeine.developpez.com/access/tutoriel/recherchemulti/
 
'Testez d'abord la solution caféine (sans jeu de mots).
'Si vous préférez des cases à cocher à une liste de choix pour la clause SELECT, alors regardez ce code.
'Si vous voulez des idées pour trier les résultats, alors regardez ce code.
'Sinon, vous n'êtes pas au bon endroit.
 
Public Tri_Group As String  'variable globale, qui sera réutilisée lors de l'ouverture de l'état
 
Private Sub chkAffectation_Click()
    Me.cmbAffectation.Visible = Not Me.cmbAffectation.Visible
    RefreshQuery
    If Me.cmbAffectation.Visible Then Me.cmbAffectation.SetFocus
End Sub
 
Private Sub chkDate_Click()
    Me.cmbDate.Visible = Not Me.cmbDate.Visible
    RefreshQuery
    If Me.cmbDate.Visible Then Me.cmbDate.SetFocus
End Sub
 
Private Sub chkDesignation_Click()
    Me.cmbDesignation.Visible = Not Me.cmbDesignation.Visible
    RefreshQuery
    If Me.cmbDesignation.Visible Then Me.cmbDesignation.SetFocus
End Sub
 
Private Sub TriEtat_Click()     'Même effet que pour la sélection : on appelle la sub RefreshQuery pour prendre en compte les changements
    RefreshQuery
End Sub
 
Private Sub TriNoGravage_Click()
    RefreshQuery
End Sub
Private Sub TriAffectation_Click()
    RefreshQuery
End Sub
Private Sub TriLieu_Click()
    RefreshQuery
End Sub
Private Sub TriUtilisation_Click()
    RefreshQuery
End Sub
Private Sub TriProchainCTR_Click()  'fin des évenements sur clic des cases à cocher pour trier
    RefreshQuery
End Sub
Private Sub RefreshQuery()
    Dim sql As String
    Dim test As Integer
    Dim SQLWhere As String
    Dim strLieu As String
    Dim strEtat As String
    Dim strUtilisation As String
 
'___________partie Lieu
 
If Me.chkLieuInterrogation Then strLieu = strLieu & ", " & Chr(34) & "?" & Chr(34)
If Me.chkLieuTF0 Then strLieu = strLieu & ", " & Chr(34) & "TF0" & Chr(34)
If Me.chkLieuTF1 Then strLieu = strLieu & ", " & Chr(34) & "TF1" & Chr(34)
If Me.chkLieuTF2 Then strLieu = strLieu & ", " & Chr(34) & "TF2" & Chr(34)
If Me.chkLieuTF3 Then strLieu = strLieu & ", " & Chr(34) & "TF3" & Chr(34)
 
If Len(strLieu) > 0 Then
    strLieu = Right(strLieu, (Len(strLieu) - 2))
    strLieu = "(" & strLieu & ")"
End If
 
'___________partie Etat
 
If Me.chkEtat1 Then strEtat = strEtat & ", " & Chr(34) & "Attente d'étalonnage" & Chr(34)
If Me.chkEtat2 Then strEtat = strEtat & ", " & Chr(34) & "En étalonnage" & Chr(34)
If Me.chkEtat3 Then strEtat = strEtat & ", " & Chr(34) & "En service" & Chr(34)
If Me.chkEtat4 Then strEtat = strEtat & ", " & Chr(34) & "Hors service" & Chr(34)
If Me.chkEtat5 Then strEtat = strEtat & ", " & Chr(34) & "Introuvable" & Chr(34)
 
If Len(strEtat) > 0 Then
    strEtat = Right(strEtat, (Len(strEtat) - 2))
    strEtat = "(" & strEtat & ")"
End If
 
'___________partie Utilisation
 
If Me.chkUtilisation1 Then strUtilisation = strUtilisation & ", " & Chr(34) & "Etalonnage" & Chr(34)
If Me.chkUtilisation2 Then strUtilisation = strUtilisation & ", " & Chr(34) & "Mesure" & Chr(34)
 
If Len(strUtilisation) > 0 Then
    strUtilisation = Right(strUtilisation, (Len(strUtilisation) - 2))
    strUtilisation = "(" & strUtilisation & ")"
End If
 
'Chacune des parties précédentes construisent une chaine qui sera ajoutée à la chaine sql...
 
sql = "SELECT NoGravage, Designation, Affectation, Lieu, Etat, Dimensions, Remarques, Utilisation, DernierCTR, ProchainCTR FROM T_OutilCTR Where True"
 
    If Not Me.chkDesignation Then
        sql = sql & " And T_OutilCTR!Designation = " & Chr(34) & Me.cmbDesignation & Chr(34)
    End If
 
    If Len(strLieu) > 0 Then                                '...seulement si elle est non-vide.
        sql = sql & " And T_OutilCTR!Lieu In " & strLieu
    Else: sql = sql & " And T_OutilCTR!Lieu = Null "
    End If
 
    If Not Me.chkAffectation Then
        sql = sql & " And T_OutilCTR!Affectation = " & Chr(34) & Me.cmbAffectation & Chr(34)
    End If
 
    If Len(strEtat) > 0 Then                                'idem ici
        sql = sql & " And T_OutilCTR!Etat In " & strEtat
    Else: sql = sql & " And T_OutilCTR!Etat = Null "
    End If
 
    If Len(strUtilisation) > 0 Then                         'et ici
        sql = sql & " And T_OutilCTR!Utilisation In " & strUtilisation
    Else: sql = sql & " And T_OutilCTR!Utilisation = Null " 'Remarque : ce genre de ligne est très personnel et un peu fantaisite
                                                            'pour moi, ça permet de vérifier si un enregistrement contient la valeu Null
    End If
 
    If Not Me.chkDate Then
        sql = sql & " And ((T_OutilCTR!ProchainCTR <=#" & Format(Me.cmbDate, "MM/DD/YYYY") & "#) Or (T_OutilCTR!ProchainCTR Is Null))"
    End If
 
SQLWhere = Trim(Right(sql, Len(sql) - InStr(sql, "Where ") - Len("Where ") + 1))
 
'____________________________________Le tri
Tri_Group = ""
 
'Ici, c'est un peu le même principe que pour les chaines de sélection multiple
 
If Me.TriLieu Then Tri_Group = Tri_Group & ", T_OutilCTR!Lieu"                  'On ajoute ou non des chaines du type "virgule" "espace" "quelquechose" ...
If Me.TriAffectation Then Tri_Group = Tri_Group & ", T_OutilCTR!Affectation"
If Me.TriEtat Then Tri_Group = Tri_Group & ", T_OutilCTR!Etat"
If Me.TriUtilisation Then Tri_Group = Tri_Group & ", T_OutilCTR!Utilisation"
If Me.TriProchainCTR Then Tri_Group = Tri_Group & ", T_OutilCTR!ProchainCTR"
If Me.TriNoGravage Then Tri_Group = Tri_Group & ", T_OutilCTR!NoGravage"
 
If Tri_Group <> "" Then Tri_Group = Trim(Right(Tri_Group, (Len(Tri_Group) - 2)))    '...puis, si la chaine est non-vide, on enlève les 2 premiers caractères (virgule et espace)...
 
'___________________________________fin tri
 
If Tri_Group <> "" Then
    sql = sql & " ORDER BY " & Tri_Group & ";"      'enfin ou ajoute le tout : la chaine sql, notre GROUP BY, puis la chaine de tri
Else: sql = sql & ";"
End If
 
Me.lblStats.Caption = DCount("*", "T_OutilCTR", SQLWhere)   'Aucun changement majeur ici
Me.lblTotal.Caption = " / " & DCount("*", "T_OutilCTR")
Me.lstResults.RowSource = sql
Me.lstResults.Requery
 
End Sub
 
Private Sub cmbAffectation_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub cmbDate_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub cmbDesignation_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub cmbUtilisation_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkLieuInterrogation_BeforeUpdate(cancel As Integer)    'A partir de là, j'ai ajouté les sub BeforeUpdate pour chaque case à cocher
    RefreshQuery
End Sub
 
Private Sub chkLieuTF0_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkLieuTF1_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkLieuTF2_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkLieuTF3_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkEtat1_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkEtat2_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkEtat3_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkEtat4_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkEtat5_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkUtilisation1_BeforeUpdate(cancel As Integer)
    RefreshQuery
End Sub
 
Private Sub chkUtilisation2_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 NoGravage, Designation, Affectation, Lieu, Etat, Dimensions, Remarques, Utilisation, DernierCTR, ProchainCTR FROM T_OutilCTR;"
Me.lstResults.Requery
 
End Sub
 
Private Sub Lister_Click()
 
DoCmd.OpenReport "E_Results", acViewDesign
 
Reports!E_Results.RecordSource = Me.lstResults.RowSource
Reports!E_Results.OrderBy = Tri_Group           'Tiens, tiens, la variable Tri_Group ! Etonnant n'est-ce pas ? :p
Reports!E_Results.OrderByOn = True              'A ne pas oublier si vous voulez Trier
 
DoCmd.OpenReport "E_Results", acViewPreview
 
End Sub
 
Private Sub lstResults_DblClick(cancel As Integer)
 
DoCmd.OpenForm "F_NoGravage_All", acNormal, , "[NoGravage] = " & Chr(34) & Me.lstResults & Chr(34)
 
End Sub
 
 
'S'il manque des explications, faites-le moi savoir ;)

Edit : en pièce jointe une capture pour se rendre compte...

Ce code est basé sur le tutoriel de caféine disponible ici.

Maxence HUBICHE · 19/04/2011, 12h50

Merci de ton partage, mais, si tu souhaite que ce soit vraiment didactique, il serait bon de mettre des commentaires

D'autre part... je crains que tu n'aies pas posté dans le bon forum

yannprada · 19/04/2011, 14h24

Quelques modifications effectuées.

Pour le déplacement, un responsable peut le faire ? ça devait être posté où sinon ? ^^

Merci

Maxence HUBICHE · 19/04/2011, 14h42

Que penses-tu de ce forum :
http://www.developpez.net/forums/f25...ss/contribuez/

yannprada · 19/04/2011, 15h22

En effet, ça semble plus approprié ! Désolé pour la bourde :s

Edit : Merci cher modérateur pour l'avoir déplacé !

19/04/2011, 12h50	#2
Maxence HUBICHE Rédacteur Maxence HUBICHE Formateur et Développeur - Conseil en Informatique Inscription : juin 2002 Messages : 3 687 Détails du profil Informations personnelles : Nom : Maxence HUBICHE Âge : 42 Localisation : France, Val d'Oise (Île de France) Informations professionnelles : Activité : Formateur et Développeur - Conseil en Informatique Informations forums : Inscription : juin 2002 Messages : 3 687 Points : 6 516 Points : 6 516	Merci de ton partage, mais, si tu souhaite que ce soit vraiment didactique, il serait bon de mettre des commentaires D'autre part... je crains que tu n'aies pas posté dans le bon forum __________________ 1formaxion, une formation de qualité, des formateurs compétents *Mes tutoriels et vidéos :* Tableaux croisés dynamiques, Access les Bases, et les autres !
	00

19/04/2011, 14h42	#4
Maxence HUBICHE Rédacteur Maxence HUBICHE Formateur et Développeur - Conseil en Informatique Inscription : juin 2002 Messages : 3 687 Détails du profil Informations personnelles : Nom : Maxence HUBICHE Âge : 42 Localisation : France, Val d'Oise (Île de France) Informations professionnelles : Activité : Formateur et Développeur - Conseil en Informatique Informations forums : Inscription : juin 2002 Messages : 3 687 Points : 6 516 Points : 6 516	Que penses-tu de ce forum : http://www.developpez.net/forums/f25...ss/contribuez/ __________________ 1formaxion, une formation de qualité, des formateurs compétents *Mes tutoriels et vidéos :* Tableaux croisés dynamiques, Access les Bases, et les autres !
	00

19/04/2011, 14h24	#3
yannprada Invité de passage Inscription : avril 2011 Messages : 7 Détails du profil Informations personnelles : Sexe : Localisation : France Informations forums : Inscription : avril 2011 Messages : 7 Points : 0 Points : 0	Quelques modifications effectuées. Pour le déplacement, un responsable peut le faire ? ça devait être posté où sinon ? ^^ Merci
	00

19/04/2011, 15h22	#5
yannprada Invité de passage Inscription : avril 2011 Messages : 7 Détails du profil Informations personnelles : Sexe : Localisation : France Informations forums : Inscription : avril 2011 Messages : 7 Points : 0 Points : 0	En effet, ça semble plus approprié ! Désolé pour la bourde :s Edit : Merci cher modérateur pour l'avoir déplacé !
	00

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email