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!
- Messages
- 1'794
- Excel
- 2010
- Inscrit
- 25/08/2014
- Emploi
- Consultant VB6 / SQL / VBA / Excel / Access
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
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