Audit trail sur un sous formulaire

**Tagada_Or** · 01/10/2014, 15h33

Bonjour à tous,

J'arrive au bout de la conception de ma base de données pour laquelle j'ai mis en place un suivi des modifications (audit trail) sur chacun des mes formulaires. J'ai pu mettre en place cet audit trail grâce au 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
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
 
Sub AuditChanges(IDField As String, UserAction As String)
    On Error GoTo AuditChanges_Err
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim datTimeCheck As Date
    Dim strUserID As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            For Each ctl In Screen.ActiveForm.Controls
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = Screen.ActiveForm.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = Screen.ActiveForm.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                .Update
            End With
    End Select
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
End Sub

Le problème est que ce code ne me renvoi que les modifications ou les ajouts qui ont lieu sur le formulaire actif (Screen.ActiveForm.Controls dans le code) et pas dans les sous-formulaires du formulaire principal. Existe-t-il une syntaxe du genre "Screen.ActiveSubForm.Controls" qui me permettent de modifier mon code afin d'avoir l'audit trail pour tous les sous-formulaires de mon formulaire principal ?

Merci beaucoup,

Tagada_or

**Jean-Philippe André** · 01/10/2014, 16h08

Salut,

lorsque tu passes sur un control, regarde son Controltype. Le sous-formulaire retournera une valeur acSubform.
Il te "suffira" alors de pointer dessus pour "descendre" d'un niveau hiérarchique

http://www.developpez.net/forums/d72...mulaire-cours/

**Tagada_Or** · 01/10/2014, 17h39

Bonjour jpcheck,

Merci pour votre retour, cependant je ne suis pas certaine d'avoir tout compris...

Envoyé par jpcheck

lorsque tu passes sur un control, regarde son Controltype. Le sous-formulaire retournera une valeur acSubform.

Je ne comprends pas exactement comment trouver la valeur acSubform, que voulez-vous dire par "passer sur un control" ?

Envoyé par jpcheck

Il te "suffira" alors de pointer dessus pour "descendre" d'un niveau hiérarchique

Si j'ai bien compris, il faudra que dans la ligne de mon code se transforme de

Code :

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

For Each ctl In Screen.ActiveForm.Controls

en

Code :

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

For Each ctl In Screen.ActiveForm.Controls and In "la valeur acSubForm"

Et de même à chaque fois que Screen.ActiveFrom.Controls apparait dans mon code ?
Est-ce bien cela ?

Merci beaucoup,

Tagada_or

**Jean-Philippe André** · 01/10/2014, 17h48

C'est presque ca oui.

Dans ta boucle tu passerais par :

Code :

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

1
2
3
4
5
6
For Each ctl In Screen.ActiveForm.Controls
Select Case ctl.ControlType
Case acSubForm:'code specifique pour le sous-formulaire
Case Else :'code pour les controls autres
End Select
Next

**Tagada_Or** · 02/10/2014, 09h42

Bonjour jpcheck,

Dans le code ci-dessous, quand vous marquez "'code spécifique pour le sous-formulaire et 'code spécifique pour les controls autres", cela signifie recopier l'intégralité de mon code dans chacun des cas ou bien la valeur acSubForm retourner par le sous-formulaire ? (d'ailleurs,je ne sais toujours pas comment trouver cette valeur...)

Code :

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

1
2
3
4
5
6
For Each ctl In Screen.ActiveForm.Controls
Select Case ctl.ControlType
Case acSubForm:'code specifique pour le sous-formulaire
Case Else :'code pour les controls autres
End Select
Next

Merci,

Tagada_or

**Tagada_Or** · 02/10/2014, 14h15

Bonjour à tous,

Malheuresuement, je ne parviens pas à faire fonctionner la solution proposée par jpcheck, et malgré toutes mes recherches, je ne parviens pas à résoudre mon problème, quelqu'un aurait-t-il un solution svp ?

Merci,

Tagada_or

**Playdo** · 02/10/2014, 23h08

Bonjour à tous,

Après quelques recherches j'ai réussi à obtenir un résultat qui me convient:
Lors de l'appel à la fonction 'AuditChanges' je passe en paramètres les Controls de mon Sous-Formulaire grâce à 'Me.Controls'

Voici le code que j'ai pour un de mes sous-formulaire :

Code :

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

1
2
3
4
5
6
7
8
 
Private Sub Form_BeforeUpdate(Cancel As Integer)
    If Me.NewRecord Then
        Call AuditChanges("NUMPAT", "NEW", Me.Controls)
    Else
        Call AuditChanges("NUMPAT", "EDIT", Me.Controls)
    End If
End Sub

Voici le code de AuditChanges 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
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
 
Sub AuditChanges(IDField As String, UserAction As String, ctls As Controls)
    On Error GoTo AuditChanges_Err
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim datTimeCheck As Date
    Dim strUserID As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            For Each ctl In ctls ' !!! Not Screen.ActiveForm.Controls !!!
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = Screen.ActiveForm.Name
                            ![Action] = UserAction
                            ![RecordID] = ctls(IDField).Value '!!! Not Screen.ActiveForm.Controls !!!
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = Screen.ActiveForm.Name
                ![Action] = UserAction
                ![RecordID] = ctls(IDField).Value ' !!! Not Screen.ActiveForm.Controls !!!
                .Update
            End With
    End Select
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
End Sub

Voilà, j'espère avoir été au plus clair.

**Tagada_Or** · 03/10/2014, 09h56

Bonjour Playdo,

Merci pour ce retour.
Cependant, mon code d'appel dans mes sous-formulaire diffère légèrement du votre :

Code :

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

1
2
3
4
5
6
7
Private Sub Form_BeforeUpdate(Cancel As Integer)
    If Me.NewRecord Then
        Call AuditChanges("NUMPAT", "NEW")
    Else
        Call AuditChanges("NUMPAT", "EDIT")
    End If
End Sub

De plus, lorsque je modifie mon deuxième argument par "Me.Controls" comme suggéré dans votre code ci-dessous, Access me renvoit l'erreur "Erreur de compilation, argument non facultatif".

Code :

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

1
2
3
4
 
Private Sub Form_BeforeUpdate(Cancel As Integer)
    Call AuditChanges("ID", Me.Controls)
End Sub

Savez_vous d'où peut venir cet erreur ?

Merci beaucoup,

Tagada_or

**Playdo** · 03/10/2014, 15h52

Bonjour,

Voir au dessus mon dernier message que j'ai modifié pour coller à votre cas de figure. La fonction 'AuditChanges' prend trois (3) arguments:

"NUMPAT", "NEW/EDIT" et Me.Controls

Cordialement.

**Tagada_Or** · 06/10/2014, 09h45

Bonjour Playdo,

Merci beaucoup de prendre le temps de me répondre.

Malheureusement, j'ai essayé le code modifié que vous avez posté et access me renvoi l'erreur suivante : "Erreur de compilation : Nombre d'arguments incorrect ou affectation de propriété incorrecte".

Il semble que la fonction CALL ne puisse prendre que deux arguments...

Existe-t-il une autre possibilité ?

Merci beaucoup,

tagada_or

**Playdo** · 06/10/2014, 15h40

Bonjour,

De mon coté tout fonctionne. je me suis servis de ce topique pour m'orienter car j'avais le même problème avec les sous formulaires.
il faut bien faire attention à l'appel de la fonction AuditChanges qui doit prendre trois arguments >>> Call AuditChanges("NUMPAT", "NEW", Me.Controls)
ainsi qu'à la définition de cette fonction qui doit également présenter trois arguments >>> Sub AuditChanges(IDField As String, UserAction As String, ctls As Controls)

Ensuite il faut bien faire attention de ne pas se mélanger entre la variable ctl qui définit un 'control' et ctls qui est la liste de tout les 'controls' du sous formulaire.

Ça devrait marcher!

**Tagada_Or** · 06/10/2014, 15h57

Merci Beaucoup Playdo, cela marche maintenant, il me manquait bien un argument dans la fonction AuditChanges !

Merci encore !!

Tagada_or

Audit trail sur un sous formulaire

VBA Access

Discussions similaires

Partager

Partager