Historique de modification par macro VBA

Bonjour à tous,

Novice en VBA, j'implore votre aide !

Je suis actuellement en train d'essayer de développer un outil plutôt simple pour la gestion des modifications documentaires (voir joint)

J'ai réussi à développer quelques macros simples elles aussi (et dieu sait que ça m'a prit du temps), mais vu que ça se complique un peu, je craque !

Actuellement j'essaie de développer une macro qui me permettra d'afficher dans une autre feuille les modifications apportées dans la première (appelée GMD) avec les informations : Qui (username déjà utilisé par l'ordinateur), Valeur avant, Valeur après, Quoi (de quel document ex : NM101xxx (celui des lignes)), Quand (Date et heure), Pourquoi (cette dernière étant à renseigner par les modificateurs) :

Tentative failed mais la plus probante (le modification se font en double (sans doute à cause de la macro pour confirmer la modification de la cellule) et les valeurs avant/après ne sont pas les bonnes (toujours à cause de la msgbox j'imagine. Mais je ne vois pas comment résoudre !

Option Explicit
Dim ValCell As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
  Application.EnableEvents = False
   If MsgBox("Êtes-vous certain de modifier la révision", vbYesNo + vbExclamation + vbDefaultButton2) = vbNo Then
    Target.Value = ValCell
   End If
  Application.EnableEvents = True
 End If

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
Worksheets("DATA").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Environ("Username")
Worksheets("DATA").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(Target.Row, 2).Value
Worksheets("DATA").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = ValCell
ValCell = Target
Worksheets("DATA").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = Target.Value
Worksheets("DATA").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = Date
End If
End Sub

 

Merci d'avance

Pas peu fière d'avoir trouvé la solution !

Bonne journée à tous

Et si jamais cela peut servir à quelqu'un :

Option Explicit
Dim Continuer As Integer, MaLigne As Long
Dim ValCell As Variant
Dim PreviousValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

' on vérifie qu'on est sur l'une des deux plages, et on demande de continuer ou non
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
    Continuer = MsgBox("Êtes-vous certain de modifier la révision ", vbYesNo + vbExclamation + vbDefaultButton2)
Else
    Exit Sub
End If

Application.EnableEvents = False
    With Worksheets("Modifications")
        ' calcul de la première ligne vide sur les 8 colonnes
        MaLigne = .UsedRange.Resize(, 8).Find("*", , , , xlRows, xlPrevious).Row + 1

        ' si on ne continue pas
        If Continuer = vbNo Then
            Target.Value = ValCell

        ' si on continue
        Else
             Pourquoi.Show
            ' on injecte les 8 valeurs directement en passant un tableau
            .Cells(MaLigne, 1).Resize(1, 8).Value = Array(Environ("USERNAME"), _
                                                              Cells(Target.Row, 2).Value, _
                                                              ValCell, Target.Value, _
                                                              IIf(Target.Column = 4, "Révision du document " & Cells(Target.Row, 2).Value, "Prise en compte de la révision du document " & Cells(2, Target.Column).Value), _
                                                              Date, _
                                                              Hour(Now) & ":" & Minute(Now), Pourquoi.TextBox1.Text)
            End If
        End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
ValCell = Target
End If
End Sub
Rechercher des sujets similaires à "historique modification macro vba"