Log des modifications apportées à une ou plusieurs cellules

Version imprimable

Bonsoir à tous,

Je planche sur une idée depuis plusieurs jours :
Dans mon travail j'utilise des documents excel que je dois remplir, notre dernier audit nous demande d'avoir une tracabilité des modifications apportées (un audit log)
J'ai cherché et trouvé comment faire cela, mais le programme ne fonctionne QUE si on ne modifie les cellules UNE A UNE.
Or il arrive que je colle des données (la tableau pouvant avoir une taille variable en fonction des cas)

J'ai cherché comment faire la même chose en utilisant un système de variable qui est variable pour mémoriser l'ancienne et la nouvelle valeur de chaque cellule de l'ensemble selectionné.

Le programme fonctionne presque mais il n'arrive jamais à bout : avez-vous une idée ?
Je planche sérieusement là ....
Code:

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 Dim PreviousValue() As String Dim thecell Dim j As Integer Private Sub Worksheet_change(ByVal target As Range) j = Selection.Cells.Count i = j For Each thecell In target For j = 1 To i Sheets("Log").Cells(6500, 1).End(xlUp).Offset(1, 0).Value = _ Application.UserName & " changed Cell " & target(j).Address _ & " from " & PreviousValue(j) & " To " & target(j).Value If j = i Then Exit Sub End If Next Next Exit Sub End Sub Private Sub Worksheet_selectionchange(ByVal target As Range) j = Selection.Cells.Count i = j ReDim PreviousValue(1 To j) MsgBox j For Each thecell In target For j = 1 To i PreviousValue(j) = target(j).Value 'MsgBox PreviousValue(j) 'MsgBox target(j).Address If j = i Then Exit Sub End If Next Next End Sub

20/03/2019, 18h18
EricDgn

Bonjour,

Pourquoi ne pas utiliser le "Suivi des modifications" (onglet Révision, groupe Modifications) ?

Cordialement
20/03/2019, 23h45
acathla

Je connaissais pas je l'ai découvert grace a toi cette fonction !!! ;-)

Elle est super interessante mais dans le cas de plusieurs modif sur la meme cellule la fonction suivie des modifications ne transcrit que la dernière modification ….
J'ai besoin de lister TOUTES les modifications faites … sur une ou un ensemble de cellules et de les noter au fur et a mesures qu'elles sont faites.

Tu peux m'aider ? :-)
21/03/2019, 10h47
EricDgn

Bonjour,

Les documents Excel à "logger" sont-ils
1) "partagés": plusieurs utilisateurs peuvent être en même temps occupés dessus et y apporter des modifications, ou
2) il n'y a que 1 personne à la fois qui travaille sur chacun de ces documents Excel ?

Si (2), l'historique pourrait se faire au moment de la sauvegarde, assez simplement par balayage des cellules (pour autant qu'il ne soit pas demandé de logger les modifications intermédiaires sur une même cellule).
Si (1), plus compliqué effectivement.

Cdt

1 pièce(s) jointe(s)

Bonjour,

Un début de solution pour un log en continu.

Code:

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
Option Explicit
 
Dim shtLog As Worksheet    '--- feuille log
Dim sPlage As String       '--- plage à logger
Dim kRz As Long            '--- dernière ligne de la plage à logger
Dim kCz As Long            '--- dernière colonne de la plage à logger
 
Private Sub Initialiser()
   Set shtLog = Sheets("Log")
   sPlage = "A1:Z100"
   kRz = 100
   kCz = 26
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim kR As Integer, kC As Integer
   Dim nR As Integer, nC As Integer
   Dim kRLog As Long
   Initialiser
   If Intersect(Target, Range(sPlage)) Is Nothing Then
      '--- ne rien faire: pas de changement
   Else
      '--- logger: changement détecté
      nR = Selection.Rows.Count        '--- erreur si colonne entière sélectionnée
      nC = Selection.Columns.Count     '--- erreur si ligne entière sélectionnée
      'Debug.Print nR, nC
      kRLog = shtLog.Cells(Rows.Count, 1).End(xlUp).Row   '--- dernière ligne + 1
      For kR = Target.Row To Target.Row + nR - 1
         For kC = Target.Column To Target.Column + nC - 1
            kRLog = kRLog + 1
            With shtLog
               .Cells(kRLog, 1) = Now()
               .Cells(kRLog, 2) = Environ("USERNAME")
               .Cells(kRLog, 3) = Cells(kR, kC).Address(False, False)
               .Cells(kRLog, 4) = Cells(kR, kC)
            End With
         Next kC
      Next kR
    End If
End Sub

Cordialement.

21/03/2019, 17h45
MarcelG

Bonjour,

Je me permets.

A toute fin utile.
Dans l'explorateur, un clic droit sur le nom du classeur permet d'afficher ses propriétés.
Parmi celles-ci, figurent les versions précédentes dont la copie dans un répertoire annexe est possible..

Citation:

Envoyé par EricDgn

Bonjour,

Un début de solution pour un log en continu.

Code:

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
Option Explicit
 
Dim shtLog As Worksheet    '--- feuille log
Dim sPlage As String       '--- plage à logger
Dim kRz As Long            '--- dernière ligne de la plage à logger
Dim kCz As Long            '--- dernière colonne de la plage à logger
 
Private Sub Initialiser()
   Set shtLog = Sheets("Log")
   sPlage = "A1:Z100"
   kRz = 100
   kCz = 26
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim kR As Integer, kC As Integer
   Dim nR As Integer, nC As Integer
   Dim kRLog As Long
   Initialiser
   If Intersect(Target, Range(sPlage)) Is Nothing Then
      '--- ne rien faire: pas de changement
   Else
      '--- logger: changement détecté
      nR = Selection.Rows.Count        '--- erreur si colonne entière sélectionnée
      nC = Selection.Columns.Count     '--- erreur si ligne entière sélectionnée
      'Debug.Print nR, nC
      kRLog = shtLog.Cells(Rows.Count, 1).End(xlUp).Row   '--- dernière ligne + 1
      For kR = Target.Row To Target.Row + nR - 1
         For kC = Target.Column To Target.Column + nC - 1
            kRLog = kRLog + 1
            With shtLog
               .Cells(kRLog, 1) = Now()
               .Cells(kRLog, 2) = Environ("USERNAME")
               .Cells(kRLog, 3) = Cells(kR, kC).Address(False, False)
               .Cells(kRLog, 4) = Cells(kR, kC)
            End With
         Next kC
      Next kR
    End If
End Sub

Cordialement.

Salut Eric,

Ton code est sympa mais j'ai également besoin de connaitre la valeur avant modification ...
Et mon code coince dans le cas ou par exemple je copie/colle plusieurs cellules d'un coup ... je n'arrive pas a mémoriser toutes les valeurs d'origines ....

Tu as une idée ?

++

22/03/2019, 09h30
acathla

Citation:

Envoyé par EricDgn

Bonjour,

Les documents Excel à "logger" sont-ils
1) "partagés": plusieurs utilisateurs peuvent être en même temps occupés dessus et y apporter des modifications, ou
2) il n'y a que 1 personne à la fois qui travaille sur chacun de ces documents Excel ?

Si (2), l'historique pourrait se faire au moment de la sauvegarde, assez simplement par balayage des cellules (pour autant qu'il ne soit pas demandé de logger les modifications intermédiaires sur une même cellule).
Si (1), plus compliqué effectivement.

Cdt

Ben justement :

Une seule personne travaille à la fois sur le documents mais j'ai besoin d'avoir toutes les modifications effectuées même si une cellule a été modifiées plusieurs fois (pour une question de suivie et tracabilité) et en plus j'ai besoin à chaque fois de connaitre la valeur AVANT et APRES modification. Et ca doit fonctionner pour une cellule modidiée ET pour plusieurs cellules (dans le document on est amené à coller une ensemble de données de plusieurs cellules (nombre totalement variable)).

Si tu as une idée je suis preneur : mon code a moi coince pour mémoriser les valeurs avant modif dans le cas de plusieurs cellules modifiées ....

1 pièce(s) jointe(s)

Bonjour,

A mon avis le plus simple est d'avoir une copie (masquée) de la feuille travaillée, et de l'utiliser pour reprendre les anciennes valeurs puis mettre les nouvelles après encodage du log.

Code:

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
Option Explicit
 
Dim shLog As Worksheet     '--- feuille log
Dim shCopy As Worksheet    '--- feuille copie de la feuille loggée
Dim sPlage As String       '--- plage à logger
 
Private Sub Initialiser()
   Set shLog = Sheets("Log")
   Set shCopy = Sheets("Data2")
   sPlage = "A1:Z100"
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim kR As Integer, kC As Integer
   Dim nR As Integer, nC As Integer
   Dim kRLog As Long
   Initialiser
   If Intersect(Target, Range(sPlage)) Is Nothing Then
      '--- ne rien faire: pas de changement
   Else
      '--- logger: changement détecté
      nR = Selection.Rows.Count        '--- erreur si colonne entière sélectionnée
      nC = Selection.Columns.Count     '--- erreur si ligne entière sélectionnée
      'Debug.Print nR, nC
      kRLog = shLog.Cells(Rows.Count, 1).End(xlUp).Row   '--- dernière ligne + 1
      For kR = Target.Row To Target.Row + nR - 1
         For kC = Target.Column To Target.Column + nC - 1
            kRLog = kRLog + 1
            With shLog
               .Cells(kRLog, 1) = Now()
               .Cells(kRLog, 2) = Environ("USERNAME")
               .Cells(kRLog, 3) = Cells(kR, kC).Address(False, False)
               .Cells(kRLog, 4) = shCopy.Cells(kR, kC)   '--- ancienne valeur
               .Cells(kRLog, 5) = Cells(kR, kC)          '--- nouvelle valeur
               shCopy.Cells(kR, kC) = Cells(kR, kC)      '--- nouvelle valeur
            End With
         Next kC
      Next kR
    End If
End Sub

Ce code ne gère pas vraiment les ajouts et suppressions de lignes ou colonnes entières.

Cordialement.

22/03/2019, 12h46
acathla

Ça marche nickel effectivement :-)

Merci !!! :-)

Est-ce que toi tu connais ce système de variable dynamique que j'ai essayé d'utiliser (Previousvalue(j)) ??
Ça fonctionne lors d'une sélection ... mais entre le programme de sélection et celui de modification les valeurs de previousvalue(j) ne sont pas conservées et je ne comprends pas pourquoi .... une idée ??

Bonjour,

En fait PreviousValue est un Range et change à chaque sélection de cellule.
Ce qui est proposé ne fonctionne que si l'on ne change que 1 cellule à la fois.
Pour comprendre voir ce qui se passe, tester ceci en sélectionnant quelques cellules à coller (Ctrl-C) puis en allant sur une autre cellule pour y effectuer le collage (Ctrl-V):
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Change(ByVal Target As Range) Debug.Print "Change", , Target.Cells(1, 1).Address, Target.Rows.Count, Target.Columns.Count End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Debug.Print "SelectionChange", Target.Cells(1, 1).Address, Target.Rows.Count, Target.Columns.Count End Sub
Bonne continuation.

22/03/2019, 14h44
acathla

Pas moyen de faire fonctionner mon code du coup ? :-/
J'aimerais autant que possible ne pas passer par une copie de la feuille d'origine ... mais si pas le choix ....

1 pièce(s) jointe(s)

Bonjour,

Un début de solution, sans avoir de feuille en copie:

Code:

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
'--- dans la feuille à logger
Option Explicit
 
Dim sNewRange As String, sOldRange As String
Dim CutCopyDejaActif As Boolean
Dim OldData()
Dim nR As Long, nC As Long, i As Long, j As Long
 
Private Sub Worksheet_Activate()
   '--- pour forcer premier SelectionChange
   If ActiveCell.Row > 1 Then
      SendKeys "{up}": SendKeys "{down}"
   Else
      SendKeys "{down}": SendKeys "{up}"
   End If
   Application.OnKey "{DEL}", "Efface"    '--- empêche utilisation touche Delete
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim kR As Long, kC As Long, kRLog As Long
   Debug.Print "Change", , Target.Cells(1, 1).Address, Target.Rows.Count, Target.Columns.Count
   Debug.Print "Application.CutCopyMode: "; Application.CutCopyMode
   kR = Target.Row
   kC = Target.Column
   With Sheets("Log")
      kRLog = .Cells(Rows.Count, 1).End(xlUp).Row   '--- dernière ligne + 1
      If Application.CutCopyMode = 0 Then
         kRLog = kRLog + 1
         .Cells(kRLog, 1) = Now()
         .Cells(kRLog, 2) = Environ("USERNAME")
         .Cells(kRLog, 3) = Cells(kR, kC).Address(False, False)
         .Cells(kRLog, 4) = OldData(0, 0)             '--- ancienne valeur
         .Cells(kRLog, 5) = Cells(kR, kC)             '--- nouvelle valeur
      ElseIf Application.CutCopyMode = xlCopy Then
         For i = 0 To nR - 1
            For j = 0 To nC - 1
               kRLog = kRLog + 1
               .Cells(kRLog, 1) = Now()
               .Cells(kRLog, 2) = Environ("USERNAME")
               .Cells(kRLog, 3) = Cells(kR + i, kC + j).Address(False, False)
               .Cells(kRLog, 4) = OldData(i, j)             '--- ancienne valeur
               .Cells(kRLog, 5) = Cells(kR + i, kC + j)     '--- nouvelle valeur
            Next j
         Next i
      Else
         MsgBox "xlCut non géré !", , " Pour info"
      End If
   End With
End Sub
 
Private Sub Worksheet_Deactivate()
   Application.OnKey "{DEL}"    '--- réactive utilisation normale touche Delete
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   Debug.Print "SelectionChange", Application.CutCopyMode
   sOldRange = sNewRange
   sNewRange = Selection.Address
   Debug.Print "sOldRange: "; sOldRange, "sNewRange: "; sNewRange
   '--- CutCopyMode:  0 = inactif, 1 = XlCopy, 2 = xlCut
   If Application.CutCopyMode = xlCopy Then
      If CutCopyDejaActif = False Then
         '--- CutCopyMode était inactif (0) avant
         CutCopyDejaActif = True
         '--- taille de la zone copiée
         nR = Range(sOldRange).Rows.Count
         nC = Range(sOldRange).Columns.Count
      End If
      '--- met en mémoire les valeurs qui seront écrasées
      ReDim OldData(nR, nC)
      For i = 0 To nR - 1
         For j = 0 To nC - 1
            Debug.Print Target.Cells(1, 1).Offset(i, j),
            OldData(i, j) = Target.Cells(1, 1).Offset(i, j)
         Next j
         Debug.Print
      Next i
   Else
      CutCopyDejaActif = False
      nR = 1
      nC = 1
      ReDim OldData(nR, nC)
      OldData(0, 0) = Target.Cells(1, 1)
   End If
End Sub
 
'--- dans un module
Public Sub Efface()
   MsgBox "Ne pas utliser la touche Delete," & vbCr & _
          "utiliser la touche Supprimer."
End Sub

mais cela ne règle pas tout, en particulier les couper/coller. A vérifier et compléter donc.

Cordialement.