Log des modifications apportées à une ou plusieurs cellules

**acathla** · 20/03/2019, 01h20

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 :

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
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

**EricDgn** · 20/03/2019, 18h18

Bonjour,

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

Cordialement

**acathla** · 20/03/2019, 23h45

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 ? :-)

**EricDgn** · 21/03/2019, 10h47

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

**EricDgn** · 21/03/2019, 17h39

Bonjour,

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

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
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.

**MarcelG** · 21/03/2019, 17h45

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..

**acathla** · 22/03/2019, 09h27

Envoyé par EricDgn

Bonjour,

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

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
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 ?

++

**acathla** · 22/03/2019, 09h30

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 ....

**EricDgn** · 22/03/2019, 12h14

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 :

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
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.

**acathla** · 22/03/2019, 12h46

Ç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 ??

**EricDgn** · 22/03/2019, 14h10

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 :

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

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.

**acathla** · 22/03/2019, 14h44

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 ....

**EricDgn** · 26/03/2019, 10h18

Bonjour,

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

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
'--- 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.

Log des modifications apportées à une ou plusieurs cellules

Macros et VBA Excel

Discussions similaires

Partager

Partager