optimisation mise à jour sous formulaire

**petitours** · 30/04/2008, 19h44

bonjour

j'ai un formulaire qui me sert à afficher dans un sous formulaire une liste d'actions à partir de tout un tas de critères que je selectionne au dessus

le code ci dessous est long mais pas tres compliqué finalement...et peu performant.

=>dans un premier temps, je crée le texte de la requete du filtre avec pleins d'étapes et des IN successifs (le IN n'est pas trés performant j'ai cru comprendre)

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
  Dim StrSQL As String
  Dim strFiltreNumRess As String
  Dim strFiltreRechercheFils As String
  Dim strFiltreRechercheFils2 As String
  Dim oRst As DAO.Recordset
  Dim oRst2 As DAO.Recordset
  Dim odb As DAO.Database
  Dim varElt As Variant
  Dim EncoreRien As Boolean
 Dim Debut As Long, Fin As Long '####pour mesure temps execution ######
 
'total dure 110ms en reseau,30ms en local
 Debut = GetTickCount() '####pour mesure temps execution ######
 
  Set odb = CurrentDb
  EncoreRien = True 'initialisation : on a encore rien mis comme condition where
 
  StrSQL = "SELECT * "
  StrSQL = StrSQL & "FROM DemandeIntervention WHERE ("
 
  If Me.SelectTri.Value = 1 Then ' si tri par date besoin
        Me.SSform_ActionsAafficher.Form.DateBesoin.ColumnOrder = 1
        Me.SSform_ActionsAafficher.Form.DateCreationDI.ColumnOrder = 15
        Me.SSform_ActionsAafficher.Form.DateTermine.ColumnOrder = 16
        Me.SSform_ActionsAafficher.Form.Priorite.ColumnOrder = 17
        Me.SSform_ActionsAafficher.Form.DateLancementAction.ColumnOrder = 18
  ElseIf Me.SelectTri.Value = 2 Then ' si tri par date creation
        Me.SSform_ActionsAafficher.Form.DateBesoin.ColumnOrder = 15
        Me.SSform_ActionsAafficher.Form.DateCreationDI.ColumnOrder = 1
        Me.SSform_ActionsAafficher.Form.DateTermine.ColumnOrder = 16
        Me.SSform_ActionsAafficher.Form.Priorite.ColumnOrder = 17
        Me.SSform_ActionsAafficher.Form.DateLancementAction.ColumnOrder = 18
  ElseIf Me.SelectTri.Value = 3 Then ' si tri par date termine
        Me.SSform_ActionsAafficher.Form.DateBesoin.ColumnOrder = 15
        Me.SSform_ActionsAafficher.Form.DateCreationDI.ColumnOrder = 16
        Me.SSform_ActionsAafficher.Form.DateTermine.ColumnOrder = 1
        Me.SSform_ActionsAafficher.Form.Priorite.ColumnOrder = 17
        Me.SSform_ActionsAafficher.Form.DateLancementAction.ColumnOrder = 18
  ElseIf Me.SelectTri.Value = 4 Then ' si tri par priorite
        Me.SSform_ActionsAafficher.Form.DateBesoin.ColumnOrder = 15
        Me.SSform_ActionsAafficher.Form.DateCreationDI.ColumnOrder = 16
        Me.SSform_ActionsAafficher.Form.DateTermine.ColumnOrder = 17
        Me.SSform_ActionsAafficher.Form.Priorite.ColumnOrder = 1
        Me.SSform_ActionsAafficher.Form.DateLancementAction.ColumnOrder = 18
  ElseIf Me.SelectTri.Value = 5 Then ' si tri par date lancement
        Me.SSform_ActionsAafficher.Form.DateBesoin.ColumnOrder = 15
        Me.SSform_ActionsAafficher.Form.DateCreationDI.ColumnOrder = 16
        Me.SSform_ActionsAafficher.Form.DateTermine.ColumnOrder = 17
        Me.SSform_ActionsAafficher.Form.Priorite.ColumnOrder = 18
        Me.SSform_ActionsAafficher.Form.DateLancementAction.ColumnOrder = 1
  End If
 
  'mettre en avant plan les nouveaux et terminé provisoir si on en a les droits (par défaut les deux casessont décochées
    If Me.Coch_TermProv.Value = True Then
        Me.SSform_ActionsAafficher.Form.TermineeProvisoir.ColumnOrder = 1
    Else
        Me.SSform_ActionsAafficher.Form.TermineeProvisoir.ColumnOrder = 15
    End If
    If Me.Coch_NewProv.Value = True Then
        Me.SSform_ActionsAafficher.Form.NouveauProvisoir.ColumnOrder = 1
    Else
        Me.SSform_ActionsAafficher.Form.NouveauProvisoir.ColumnOrder = 15
    End If
 
  If Me.Cdr_Selection.Value = 1 Then 'si on a coché "toutes les interventions
 
  ElseIf Me.Cdr_Selection.Value = 3 Then 'si on a coché intervention sur ressource selectionnée avec ses fils
 
    '######Recherche des fils
    strFiltreRechercheFils = "SELECT NumRessource,CODERESS,[LIB1-20] FROM RessMaint WHERE NumParent = " & Me.Txt_NumRessSelected.Caption
    Set oRst = odb.OpenRecordset(strFiltreRechercheFils)
    strFiltreRechercheFils = "" ' init de la variable
    While Not oRst.EOF
        strFiltreRechercheFils2 = "SELECT NumRessource,CODERESS,[LIB1-20] FROM RessMaint WHERE NumParent = " & oRst.Fields(0).Value
        Set oRst2 = odb.OpenRecordset(strFiltreRechercheFils2)
        While Not oRst2.EOF
            strFiltreRechercheFils = strFiltreRechercheFils & oRst2.Fields(0).Value & ","
            oRst2.MoveNext 'Passe à l'enregistrement suivant
        Wend
        oRst2.Close: Set oRst2 = Nothing 'Ferme le recordset
 
        strFiltreRechercheFils = strFiltreRechercheFils & oRst.Fields(0).Value & ","
        oRst.MoveNext 'Passe à l'enregistrement suivant
    Wend
    oRst.Close: Set oRst = Nothing 'Ferme le recordset
 
    strFiltreRechercheFils = " IN (" & strFiltreRechercheFils & Me.Txt_NumRessSelected.Caption & ") "
    '######Fin recherche des fils
 
     StrSQL = StrSQL & " (DemandeIntervention.RessourceConcernee " & strFiltreRechercheFils & ")"
     EncoreRien = False ' on a mis une première condition where
  Else 'si on a coché intervention sur ressource selectionnée seule, sans ses fils
     strFiltreRechercheFils = " IN (" & Me.Txt_NumRessSelected.Caption & ") "
     StrSQL = StrSQL & " (DemandeIntervention.RessourceConcernee " & strFiltreRechercheFils & ")"
     EncoreRien = False ' on a mis une première condition where
  End If
 
  '## début test conditions des filtres suivants
  If Me.Lst_EtatAction.ItemsSelected.Count = 0 Then Call Bt_toutSelectListeEtatAction_Click  'on active le premier élément de la liste si rien de coché
  If Me.Lst_PrevCur.ItemsSelected.Count = 0 Then Call Bt_toutSelectListeType_Click
  If Me.Lst_Demandeur.ItemsSelected.Count = 0 Then Call Bt_toutSelectListeDemandeur_Click
  If Me.Lst_TypeInterv.ItemsSelected.Count = 0 Then Call Bt_toutSelectListeTypeInterv_Click
  If Me.Lst_DomainInterv.ItemsSelected.Count = 0 Then Call Bt_toutSelectListeDomaineInterv_Click
  If Me.Lst_Intervenants.ItemsSelected.Count = 0 Then Call Bt_toutSelectListeIntervenant_Click
 
  strFiltreRechercheFils = "" 'init du string
  For Each varElt In Me.Lst_EtatAction.ItemsSelected
        strFiltreRechercheFils = strFiltreRechercheFils & Me.Lst_EtatAction.ItemData(varElt) & ","
  Next varElt
  strFiltreRechercheFils = " IN (" & Left(strFiltreRechercheFils, Len(strFiltreRechercheFils) - 1) & ") "
  If EncoreRien = True Then
    StrSQL = StrSQL & " (DemandeIntervention.EtatAction " & strFiltreRechercheFils & ")"
  Else
    StrSQL = StrSQL & " AND (DemandeIntervention.EtatAction " & strFiltreRechercheFils & ")"
  End If
 
  strFiltreRechercheFils = "" 'init du string
  For Each varElt In Me.Lst_Demandeur.ItemsSelected
        strFiltreRechercheFils = strFiltreRechercheFils & Me.Lst_Demandeur.ItemData(varElt) & ","
  Next varElt
  strFiltreRechercheFils = " IN (" & Left(strFiltreRechercheFils, Len(strFiltreRechercheFils) - 1) & ") "
  StrSQL = StrSQL & " AND (DemandeIntervention.Demandeur " & strFiltreRechercheFils & ")"
 
  strFiltreRechercheFils = "" 'init du string
  For Each varElt In Me.Lst_PrevCur.ItemsSelected
        strFiltreRechercheFils = strFiltreRechercheFils & Me.Lst_PrevCur.ItemData(varElt) & ","
  Next varElt
  strFiltreRechercheFils = " IN (" & Left(strFiltreRechercheFils, Len(strFiltreRechercheFils) - 1) & ") "
  StrSQL = StrSQL & " AND (DemandeIntervention.PrevCur " & strFiltreRechercheFils & ")"
 
  strFiltreRechercheFils = "" 'init du string
  For Each varElt In Me.Lst_TypeInterv.ItemsSelected
        strFiltreRechercheFils = strFiltreRechercheFils & Me.Lst_TypeInterv.ItemData(varElt) & ","
  Next varElt
  strFiltreRechercheFils = " IN (" & Left(strFiltreRechercheFils, Len(strFiltreRechercheFils) - 1) & ") "
  StrSQL = StrSQL & " AND (DemandeIntervention.TypeIntervention " & strFiltreRechercheFils & ")"
 
  strFiltreRechercheFils = "" 'init du string
  For Each varElt In Me.Lst_DomainInterv.ItemsSelected
        strFiltreRechercheFils = strFiltreRechercheFils & Me.Lst_DomainInterv.ItemData(varElt) & ","
  Next varElt
  strFiltreRechercheFils = " IN (" & Left(strFiltreRechercheFils, Len(strFiltreRechercheFils) - 1) & ") "
  StrSQL = StrSQL & " AND (DemandeIntervention.DomaineIntervention " & strFiltreRechercheFils & ")"
 
  strFiltreRechercheFils = "" 'init du string
  For Each varElt In Me.Lst_Intervenants.ItemsSelected
        strFiltreRechercheFils = strFiltreRechercheFils & Me.Lst_Intervenants.ItemData(varElt) & ","
  Next varElt
  strFiltreRechercheFils = " IN (" & Left(strFiltreRechercheFils, Len(strFiltreRechercheFils) - 1) & ") "
  StrSQL = StrSQL & " AND (DemandeIntervention.Intervenant " & strFiltreRechercheFils & ")"
 
  If Me.Coch_MachineArret.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.MachineArretee = true )"
  End If
 
  If Me.Coch_DangerPerson.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.DangerPourLaPersonne = true )"
  End If
 
  If Me.Coch_ArretGenant.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.ArretMachineGenant = true )"
  End If
 
  If Me.Coch_PetiteInterv.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.PetiteIntervention = true )"
  End If
 
  If Me.Coch_AvecArretProd.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.SansProdUsine = true )"
  End If
 
  If Me.Coch_AchatAFaire.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.AchatAFaire = true )"
  End If
 
  If Me.Coch_NewProv.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.NouveauProvisoir = true )"
  End If
 
  If Me.Coch_TermProv.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.TermineeProvisoir = true )"
  End If
 
  If Me.Coch_SansAffichPreventif.Value = True Then
    StrSQL = StrSQL & " AND (DemandeIntervention.IDpreventive = 0 )"
  End If
  '## FIN test conditions des filtres suivants
 
  StrSQL = StrSQL & ") "
 
  If Me.CochInverseFiltre.Value = False Then
    If Me.SelectTri.Value = 1 Then ' si tri par date besoin
      StrSQL = StrSQL & "ORDER BY DateBesoin DESC"
    ElseIf Me.SelectTri.Value = 2 Then ' si tri par date creation
      StrSQL = StrSQL & "ORDER BY DateCreationDI DESC"
    ElseIf Me.SelectTri.Value = 3 Then ' si tri par date termine
      StrSQL = StrSQL & "ORDER BY DateTermine DESC"
    ElseIf Me.SelectTri.Value = 4 Then ' si tri par priorite
      StrSQL = StrSQL & "ORDER BY Priorite"
    ElseIf Me.SelectTri.Value = 5 Then ' si tri par dateLancement
      StrSQL = StrSQL & "ORDER BY DateLancementAction DESC"
    End If
  Else 'la meme chose mais avec ordre affichage inversé
    If Me.SelectTri.Value = 1 Then ' si tri par date besoin
      StrSQL = StrSQL & "ORDER BY DateBesoin"
    ElseIf Me.SelectTri.Value = 2 Then ' si tri par date creation
      StrSQL = StrSQL & "ORDER BY DateCreationDI"
    ElseIf Me.SelectTri.Value = 3 Then ' si tri par date termine
      StrSQL = StrSQL & "ORDER BY DateTermine"
    ElseIf Me.SelectTri.Value = 4 Then ' si tri par priorite
      StrSQL = StrSQL & "ORDER BY Priorite  DESC"
    ElseIf Me.SelectTri.Value = 5 Then ' si tri par dateLancement
      StrSQL = StrSQL & "ORDER BY DateLancementAction"
    End If
  End If
 
      Fin = GetTickCount() '####pour mesure temps execution ######
    MsgBox "creation requete en millisecondes : " & Fin - Debut

=> ensuite, je mets à jour la source du sous formulaire

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    Debut = GetTickCount() '####pour mesure temps execution ######
 
 
  Me.SSform_ActionsAafficher.Form.RecordSource = StrSQL
 'compte le nombre d'enregistrements affichés
 Set oRst = odb.OpenRecordset(Me.SSform_ActionsAafficher.Form.RecordSource)
    If oRst.RecordCount > 0 Then oRst.MoveLast ' on va au dernier enregistrement pour compter
    Me.Etiq_NbResultat.Caption = oRst.RecordCount & " résultats"
 
 oRst.Close: Set oRst = Nothing 'Ferme le recordset
    Fin = GetTickCount() '####pour mesure temps execution ######
    MsgBox "Taffichage et comptageen millisecondes : " & Fin - Debut

Je pensais que la création de la requete était trés lente mais ca ne prend "que" 15ms.
La simple ligne

Code :

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

Me.SSform_ActionsAafficher.Form.RecordSource = StrSQL

dure 85ms par contre ! et ca je ne vois pas du tout comment l'optimiser

Sauriez vous me guider pour optimiser la mise à jour de la source du sous formulaire ?

Merci par avance

optimisation mise à jour sous formulaire

IHM

Discussions similaires

Partager

Partager