Discussion :

[Lari81]

Bonjour à tous,

Lorsqu'on souhaite réaliser un traitement en VBA après suppression d'enregistrements, le fonctionnement d'Access ne semble pas très pratique (sauf erreur de ma part)
En effet, selon l'option Confirm Record Changes (accessible depuis le menu Options/Paramètres du client/Confirmer Modification des enregistrements en V13 par exemple), le comportement change :

Si l'option n'est de ne pas confirmer, pas de problème. Seuls les delete sont appelés pour chaque ligne supprimée et il est possible d'y placer son traitement

En revanche, si l'option est de confirmer, les événements se produisent comme suit

delete
delete
...
delete

BeforeDelConfirm
AfterDelConfirm

Il n'est pas possible d'implanter le traitement dans le delete puisque les suppressions peuvent être annulées par l'utilisateur ou dans le beforeDelConfirm.

Puisque la suppression effective n'a lieu que dans le afterDelConfirm, je ne vois pas d'autre possibilité que de collecter au moment des delete, dans un ou des tableaux, les données dont j'ai besoin pour faire les traitements nécessaires pour chaque suppression, et, si les suppressions sont confirmées, boucler dans le afterDelConfirm sur ces tableaux et réaliser les traitements à faire.

... ce qui ne dispense pas de faire malgré tout les traitements dans les delete dans le cas ou l'option n'est pas sur confirmer (puisque alors, afterDelConfirm n'est jamais appelé...)


Pas très élégant et pratique je trouve. Il manquerait un delete appelé pour chaque enregistrement EFFECTIVEMENT SUPPRIME, comme dans un trigger par exemple... ou un moyen de contrôler des transactions dans les formulaires pour annuler en masse tout ce qui s'est fait, suppression et traitements associés dans les delete, s'ils ont été annulés in fine par l'utilisateur.

Vos pratiques en la matière ?

Zaz

[marot_r]

Bonjour.

Oui, tu as raison, Access ne dispose que depuis peu de triggers (macro de données) et encore c'est assez imparfait.
Donc d'habitude on ne fait pas de traitement sur une suppression, ce qui suppose que tu gardes un résultat gelé quelque part dans une table.
On fait des requêtes qui calcule le résultat au moment où en a besoin.

Donc au lieu d'avoir par exemple :

tblVenteClient
ClefClient
MontantVenteClient

tblDetailVenteClient
ClefDetailVente
ClefClient
MontantDetailVente

Où MontantVenteClient est augmenter à chaque vente et diminuer à chaque retour de produit.

On aura

tblDetailVenteClient
ClefDetailVente
ClefClient
MontantDetailVente

et une requête du type

Code sql :

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

1
2
select tblDetailVenteClient.ClefClient, Sum(tblDetailVenteClient.MontantDetailVente) as MontantVenteClient from tblDetailVenteClient
group by tblDetailVenteClient.ClefClient

Même chose pour un stock de produits, le stock courant = somme des entrées - somme des sorrties.

Le seul cas où c'est VRAIMENT pénible c'est si on veut faire une journalisation des opérations par exemple pour savoir qui a supprimé tel enregistrement.
Là il faut intercepter le code de suppression.
Une astuce est de ne pas autoriser les suppression et de mettre un champ booléen du type EstSupprime à vrai quand l'enregistrement ne doit plus être vu par l'utilisateur.
L'enregistrement reste là mais il n'est plus affiché. Si on a pas de problème de place ce peut être une bonne solution avec éventuellement un traitement de suppression physique en batch à la sortie de l'appli.

A+

[Lari81]

OK, merci de m'avoir confirmé que je n'étais pas passé à coté de quelque chose.

En l’occurrence, j'ai une intégrité référentielle "lâche" entre les deux possibilités d'access : je ne dois pas empêcher de supprimer l'enregistrement maitre s'il y a des lignes détail, ni supprimer automatiquement les détails à la suppression de la ligne maîtresse, mais supprimer la référence à la ligne maîtresse lorsqu'elle est supprimée. Chose qui prend place naturellement dans un trigger.

Je pourrais créer une macro de données, mais le suis en structure front/back et j'ai pris le parti de ne pas intervenir sur les datas de l'utilisateur. Je programme les modifications de structure à l'autoexec, en VBA. Et comme il n'est pas possible de créer une macro de données en VBA...

Bon, j'ai bidouillé un petit module de classe pour essayer de faire ça propre et pouvoir le plugger dans les différents formulaires et sous-formulaires qui contiennent la table maitresse. Si ça peut servir...

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
 
Option Compare Database
Option Explicit
 
'==============================================================================================================
' Classe clDeletions
'
' Version : 0001
'
' Description :
' Permet de lancer une procédure lorsque des enregistrements sont effectivement supprimés, quelle que soit la valeur de
' l'option Confirm Record Changes (Options/Paramètres du client/Confirmer Modification des enregistrements)
'
' Problématique :
' Si on souhaite faire un traitement sur suppression d'enregistrement, soit l'option est cochée
' et dans ce cas, beforeDelConfirm ou le dialogue standard de confirmation est appelé et les suppressions peuvent
' être annulée. Donc pas possible de programmer les modifs dans l'événement Delete.
' Soit elle n'est pas cochée, et aucun autre événement que Delete n'est appelé...
'
' clDeletions permet de déclarer une méthode appelé lorsque les enregistrements sont supprimés effectivement, que ce soit
' avec ou sans l'option
'
' Usage :
' Créer une variable dans le formulaire
'  Dim WithEvents del as clDeletions
' La créer et l'initialiser dans le open ou load avec le nom du champ clé
'  set del = new clDeletions
'  del.init(Me, "ID")
' Ajouter éventuellement les autres champs à récupérer
'  del.addField("Nom")
' Déclarer et programmer la procédure qui sera appelée pour chaque enregistrement effectivement supprimé
'  Sub del_deleted(index As Variant, values As Variant)
' index contient la clé de l'enregistrement, si addFields, values contient un tableau(0) des valeurs stockées
' Nettoyer la variable dans le close du formulaire
'  set del = nothing
'==============================================================================================================
 
 
Const kModule = "clDeletions."
 
Public Event deleted(index As Variant, values As Variant)
 
 
Private WithEvents This As Access.Form
Private IndexName As String
Private indexes() As Variant
Private fieldNames() As Variant
Private fields() As Variant
 
Private doDeletions As Boolean
Private iDelete As Long ' numéro d'appel à Delete
Private iDeletion As Long ' numéro de suppression - tenant compte des éventuelles annulations
 
Private savedTimerInterval As Long
 
Private Sub class_Initialize()
  'Debug.Print kModuleName & "class_Initialize"
End Sub
 
 
' Initialiser avec le formulaire
Sub init(F As Access.Form, idxName As String)
  Const kFunction = kModule & "init": On Error GoTo err
 
  Set This = F
  This.OnDelete = "[Event Procedure]"
  This.BeforeDelConfirm = "[Event Procedure]"
  This.AfterDelConfirm = "[Event Procedure]"
  This.OnTimer = "[Event Procedure]"
 
  ' nom du champ clé
  IndexName = idxName
 
  'Initialiser compteur de suppressions
  iDelete = 0
  iDeletion = 0
 
  Exit Sub
err:
  queueError err, kFunction
End Sub
 
Sub addField(fieldName As String)
  Const kFunction = kModule & "addField": On Error GoTo err
 
  arrayAdd fieldNames, fieldName
 
  Exit Sub
err:
  queueError err, kFunction
End Sub
 
Property Get confirmDeletions() As Boolean
  On Error Resume Next
  confirmDeletions = Application.GetOption("Confirm Record Changes")
End Property
 
Property Let confirmDeletions(confirm As Boolean)
  Const kFunction = kModule & "confirmDeletions": On Error GoTo err
 
  Application.SetOption "Confirm Record Changes", confirm
 
  Exit Property
err:
  queueError err, kFunction
End Property
 
Private Sub This_Delete(Cancel As Integer)
  Const kOperation = "Suppression": Const kFunction = kModule & "This_Delete": On Error GoTo err
  'Debug.Print " This_Delete. Cancel = " & Cancel
 
  iDelete = iDelete + 1
 
  ' premier delete. Initialiser le tableau des indexs
  If iDelete = 1 Then
    Erase indexes
    Erase fields
  End If
 
  If Not Cancel Then
    iDeletion = iDeletion + 1
 
  ' Ajouter la clé au tableau des indexes
    arrayAdd indexes, This(IndexName)
 
    ' s'il y a d'autres champs à sauvegarder...
    If arraySize(fieldNames) > 0 Then
      ' redimensionner le tableau des valeurs au nombre de champs et nombre courant de suppression
      ReDim Preserve fields(0 To arraySize(fieldNames) - 1, 0 To iDeletion - 1)
      ' parcourir et stocker les valeurs des champs à sauvegarder
      Dim iField As Long: iField = 0
      Dim fieldName As Variant
      For Each fieldName In fieldNames
        fields(iField, iDeletion - 1) = This(fieldName)
        iField = iField + 1
      Next fieldName
    End If
  End If
 
  ' si on est sur la dernière ligne à supprimer...
  If iDelete = This.SelHeight Then
    ' s'il y a eu des suppressions effectives...
    If iDeletion > 0 Then
      ' s'il n'y a pas de confirmation, il n'y aura ni dialogue ni beforeDelConfirm
      ' Programmer le lancement des delete dans le timer (pour ne pas perturber la dernière suppression)
      If Not Application.GetOption("Confirm Record Changes") Then
        ' Sauvegarder l'interval courant et le passer à 1
        savedTimerInterval = This.TimerInterval
        This.TimerInterval = 1
        ' indiquer qu'il faut lancer les delete
        doDeletions = True
      End If
    End If
    ' réinitialiser les compteurs
    iDelete = 0
    iDeletion = 0
  End If
 
  Exit Sub
err:
  Cancel = True
  showAppErrorAlert err, kOperation, kFunction: Exit Sub
  Resume
End Sub
 
Private Sub This_BeforeDelConfirm(Cancel As Integer, Response As Integer)
  Const kOperation = "Suppression": Const kFunction = kModule & "This_BeforeDelConfirm": On Error GoTo err
 
  ' Debug.Print " This_BeforeDelConfirm. Cancel = " & Cancel & " Response = " & Response
 
  ' Response
  '  acDataErrDisplay : si non Cancel : affiche le dialogue standard de confirmation
  '  acDataErrContinue : n'affiche pas le dialogue standard
 
  ' rien à faire
 
  Exit Sub
err:
  showAppErrorAlert err, kOperation, kFunction
End Sub
 
Private Sub This_AfterDelConfirm(Status As Integer)
  Const kOperation = "Suppression": Const kFunction = kModule & "This_AfterDelConfirm": On Error GoTo err
 
  ' Debug.Print " This_AfterDelConfirm. Status =  " & Status
 
  ' est appelé dans tous les cas (cancel ou non). Cancel permet de savoir ce qui a été fait auparavant
  '  acDeleteOK : la suppression a eu lieu
  '  acDeleteUserCancel  : annulation par l'utilisateur avec le dialogue standard
  '  acDeleteCancel : annulation par programme dans le BeforeDelConfirm (Cancel = true)
 
  ' s'il n'y a pas eu d'annulation précédemment, lancer les suppressions
  If Status = Access.acDeleteOK Then
    deletions
  End If
 
  Exit Sub
err:
  showAppErrorAlert err, kOperation, kFunction
End Sub
 
Private Sub This_Timer()
  Const kOperation = "Suppression": Const kFunction = kModule & "This_Timer": On Error GoTo err
  'Debug.Print " This_Timer"
 
  ' au cas ou le timer serait activé par ailleurs, ne traiter que si doDeletions est vrai
  If doDeletions Then
    deletions
    doDeletions = False
    ' ne restaurer l'intervale que s'il n'a pas été réinitialisé dans la proc timer de base
    If This.TimerInterval <> 0 Then
      This.TimerInterval = savedTimerInterval
    End If
  End If
 
  Exit Sub
err:
  showAppErrorAlert err, kOperation, kFunction
End Sub
 
 
 
Private Sub deletions()
  Const kFunction = kModule & "confirmDeletions": On Error GoTo err
 
  Dim fieldValues() As Variant
 
  ' parcourir chaque trace d'enregistrement supprimé
  Dim iRec As Long
  iRec = 0
  Dim index As Variant
  For Each index In indexes
    ' Debug.Print index
    ' s'il y a des champs supplémentaires déclarés
    If arraySize(fieldNames) > 0 Then
      ' composer le tableau des champs à la taille du nombre de champs
      ReDim fieldValues(0 To arraySize(fieldNames) - 1)
      Dim iFld As Long
      iFld = 0
      ' parcourir chaque nom de champ
      Dim fieldName As Variant
      For Each fieldName In fieldNames
        ' stocker la valeur du champ
        fieldValues(iFld) = fields(iFld, iRec)
        iFld = iFld + 1
      Next fieldName
      RaiseEvent deleted(index, fieldValues)
    Else
      RaiseEvent deleted(index, Null)
    End If
    iRec = iRec + 1
  Next index
 
  'MsgBox "Deletions done"
 
  Exit Sub
err:
  queueError err, kFunction
End Sub
 
Private Sub class_Terminate()
  'Debug.Print kModuleName & "class_Terminate"
End Sub
 
'==================================================
' ajouter _ au noms si module uArray est présent
Function arraySize(arr As Variant) As Long
  On Error GoTo err
  arraySize = UBound(arr) - LBound(arr) + 1
  Exit Function
err:
  arraySize = 0
End Function
 
Function arrayAdd(ByRef arr As Variant, value As Variant)
  On Error GoTo err
  ReDim Preserve arr(UBound(arr) + 1)
  arr(UBound(arr)) = value
 
  Exit Function
err:
  ReDim Preserve arr(0 To 0)
  Resume Next
End Function
 
 
' ajouter _ au nom pour désactiver si module uError présent
Sub queueError(err As ErrObject, source As String, Optional ByVal step As String)
  err.Raise err.Number, source:=source & VBA.vbCrLf  & err.source, description:=err.description
End Sub
 
Public Function showAppErrorAlert(e As ErrObject, operationName As String, functionName As String, Optional ByVal step As String)
  Dim message As String
  message = err.description & VBA.vbCrLf & _
            "(Erreur n° " & err.Number & ")" & VBA.vbCrLf & VBA.vbCrLf & _
            "  Fonction " & functionName & step & _
            err.source
  VBA.MsgBox "Une erreur est survenue." & VBA.vbCrLf & VBA.vbCrLf & message, VBA.vbExclamation, getAppName() & " - " & operationName & " -"
End Function '-- showAppErrorAlert