Comment faire un audit log?

bonjour,

je voudrais faire un audit log (journal d'audit en français d'après Google Translate), qui indique pour chaque cellule modifiée, son ancienne valeur et sa nouvelle valeur.

Quelqu'un peut-il m'aider pour déterminer l'ancienne valeur de la cellule changée? Merci

Pour les autres champs, c'est ok, voici mon code:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Range("NAHApps"), Target) Is Nothing Then
        With Worksheets("AuditLog").Cells(1).End(xlDown).Offset(1, 0)
           .Offset(0, 0).Formula = Fix(Now())                                      'Date
            .Offset(0, 1).Formula = Now() - Fix(Now())                         'Heure
            .Offset(0, 2).Formula = "GMT+1"                                       'Fuseau Horaire
            .Offset(0, 3).Formula = Application.UserName                  'Auteur
            .Offset(0, 4).Formula = Target.Offset(0, -Target.Column + 1)             'Id de l'application
            .Offset(0, 5).Formula = Target.Address                              'Cellule changée
            .Offset(0, 6).Formula = ""                                            ' Ancienne Valeur???
            .Offset(0, 7).Formula = Target.Formula                              'Nouvelle Valeur
        End With
    End If
End Sub

Si en plus vous pouvez me dire comment extraire le fuseau horaire de Windows, Ce serait la cerise sur le gateau!

Bonsoir,

Ci-joint une proposition avec des pistes à explorer.

  • Pour récupérer l'ancienne valeur : faire un "Undo" (retour arrière), stocker la valeur, et remettre la bonne valeur
  • Pour le fuseau horaire : API trouvée sur le net (API 32 bits, en poste 64 bits, ajouter l'instruction "PtrSafe" (à voir ...)

Bonne soirée

Bouben

116auditlog.xlsm (25.58 Ko)

Merci Bouben,

Je voulais justement éviter le UNDO, vu le coût CPU de son exécution et l'absurdité de la manœuvre... En postant ma question j'avais espoir qu'autre chose me soit indiqué.

Même remarque pour le fuseau horaire: je pense qu'il devrait faire partie des options de formatage d'une date dans Excel, pas qu'on doive le traiter séparément. Dans ce contexte de mondialisation, ce serait pas mal non? Aujourd'hui tout le monde code en dur cette info. Ou on change tous à l'heure universelle (ce que je préférerais encore plus!)

Mis à part mes caprices et mes rêves ci-dessus, merci pour le programme qui marche très bien!

Salutations amicales,

Stefano

J'ai réfléchi et dans une pensée salutaire et plus réaliste j'ai décidé d'implementer ton code!

Merci encore!

Private Sub Worksheet_Change(ByVal Target As Range)
    Static blnLogged As Boolean
    Dim intTimeOffset As Integer
    Dim strTimeOffset As String
    Dim intHour As Integer
    Dim intMin As Integer

    If Not Intersect(Range("NAHApps"), Target) Is Nothing Then
        If Not blnLogged Then 'to avoid looping
            blnLogged = True
            Application.ScreenUpdating = False
            With Worksheets("AuditLog").Cells(1).End(xlDown).Offset(1, 0)
                .Offset(0, 0).Formula = Fix(Now())
                .Offset(0, 1).Formula = Now() - Fix(Now())
                intTimeOffset = TimeOffsetInMinutes()
                intHour = Abs(Int(intTimeOffset / 60))
                intMin = Abs(intTimeOffset) - (60 * intHour)
                strTimeOffset = Format(intHour, "00")
                If intMin Then
                    strTimeOffset = strTimeOffset & ":" & Format(intMin, "00")
                End If
                If intTimeOffset = 0 Then
                    .Offset(0, 2).Formula = "GMT"
                ElseIf intTimeOffset < 0 Then
                    .Offset(0, 2).Formula = "GMT-" & strTimeOffset
                Else
                    .Offset(0, 2).Formula = "GMT+" & strTimeOffset
                End If
                .Offset(0, 3).Formula = Application.UserName
                .Offset(0, 4).Formula = Target.Offset(0, -Target.Column + 1)
                .Offset(0, 5).Formula = Target.Offset(-Target.Row + 6, 0).Value
                Application.Undo
                .Offset(0, 6).Formula = Target.Value
                Application.Undo
                .Offset(0, 7).Formula = Target.Formula
                blnLogged = False
            End With
            Application.ScreenUpdating = True
        End If
    End If
End Sub

bonjour,

je voulais transformer la fonction pour qu'elle couvre aussi les cas où plusieurs cellules sont changées en même temps. Cela peut arriver en sélectionnant plusieurs cellules et en cliquant sur DELETE, ou en utilisant control-D ou control-R...)

J'ai ainsi cru bon boucler sur les cellules de la plage Target, en modifiant le programme comme ci-dessous. En gros ça marche, mais il me semble qu'il y ait des problèmes avec le undo... Intéressant.

Faites-moi savoir ce que vous en pensez.

Merci,

Stefano

Private Sub Worksheet_Change(ByVal Target As Range)
    Static blnLogged As Boolean
    Dim rngEditedCell As Range
    Dim intTimeOffset As Integer
    Dim strTimeOffset As String
    Dim intHour As Integer
    Dim intMin As Integer

    Application.ScreenUpdating = False
    If Not Intersect(Range("NAHApps"), Target) Is Nothing Then
        For Each rngEditedCell In Target
            If Not blnLogged Then 'to avoid recursive looping
                blnLogged = True
                With Worksheets("AuditLog").Cells(1).End(xlDown).Offset(1, 0)
                    .Offset(0, 0).Formula = Fix(Now())
                    .Offset(0, 1).Formula = Now() - Fix(Now())
                    intTimeOffset = TimeOffsetInMinutes()
                    intHour = Abs(Int(intTimeOffset / 60))
                    intMin = Abs(intTimeOffset) - (60 * intHour)
                    strTimeOffset = Format(intHour, "00")
                    If intMin Then
                        strTimeOffset = strTimeOffset & ":" & Format(intMin, "00")
                    End If
                    If intTimeOffset = 0 Then
                        .Offset(0, 2).Formula = "GMT"
                    ElseIf intTimeOffset < 0 Then
                        .Offset(0, 2).Formula = "GMT-" & strTimeOffset
                    Else
                        .Offset(0, 2).Formula = "GMT+" & strTimeOffset
                    End If
                    .Offset(0, 3).Formula = Application.UserName
                    .Offset(0, 4).Formula = rngEditedCell.Offset(0, -Target.Column + 1)
                    .Offset(0, 5).Formula = rngEditedCell.Offset(0, -Target.Column + 2)
                    .Offset(0, 6).Formula = rngEditedCell.Offset(-rngEditedCell.Row + 6, 0).Value
                    Application.Undo
                    .Offset(0, 7).Formula = rngEditedCell.Value
                    Application.Undo
                    .Offset(0, 8).Formula = rngEditedCell.Formula
                    blnLogged = False
                End With
            End If
        Next rngEditedCell
    End If
    Application.ScreenUpdating = True
End Sub
Rechercher des sujets similaires à "comment audit log"