[résolu]Macro d'historisation des modifications

[mikachu]

Bonjour à tous !

J'ai créé (non sans mal, mais google est mon ami) des macros me permettant d'historiser les modifications réalisées dans un fichier.

En gros j'ai 2 feuilles, une première "liste" qui reprend des travaux à réaliser et une deuxième feuille "modifications" qui comprend un historique.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name Like "liste" Then Exit Sub
If Target.Count > 1 Then Exit Sub
memo1 = Target.Value
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
 If Not Sh.Name Like "liste" Then Exit Sub
 If Target.Address = "$H$1" Then Exit Sub
 L = Sheets("modifications").Range("A65536").End(xlUp).Row
 Sheets("modifications").Range("A" & L + 1) = Format(Date, _
 "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss")
 Sheets("modifications").Range("B" & L + 1) = Target.AddressLocal
 Sheets("modifications").Range("C" & L + 1) = memo1
 Sheets("modifications").Range("D" & L + 1) = Target.Value
 Sheets("modifications").Range("E" & L + 1) =  ActiveWorkbook.UserStatus

En gros, dans la première macro, à chaque fois que je sélectionne une case de la feuille "liste", j'enregistre la valeur de la case dans une variable.

Dans la deuxième macro, si la case sélectionnée est modifiée, alors je vais implémenter la feuille "modifications" avec la case, l'ancienne valeur, la nouvelle valeur, la date de modif et la personne qui a modifié.

Le problème est en cas de sélection multiple...

Je voudrais que si je fais un copier / coller sur une sélection multiple, la macro me créé autant de lignes dans le tableau modif que de cases ainsi modifiées.

Help please

En espérant avoir été clair, merci d'avance

 

[mikachu]

Re : Macro d'historisation des modifications

Pour etre plus clair, voici le tableau en question (simplifié)

Faites une modification dans "liste" et regardez l'impact dans "modifications"
Ensuite, par exemple, copiez / collez le commentaire de la ligne 4 dans les lignes lignes 5,6,7 via sélection multiple.

Au lieu d'une ligne me donnant l'ensemble des cellules modifiées, je voudrait une ligne par cellule

Encore merci

 

[JNP]

Re : Macro d'historisation des modifications

Bonsoir Michaku ,
A améliorer et en utilisant Feuil3 pour stocker

Dim memo1 As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("Feuil3").Cells.Clear
End Sub
Private Sub Workbook_Open()
    If ActiveSheet.Name = "liste" Then
        With Sheets("Feuil3")
            memo1 = Selection.Address
            .Range(memo1).Value = Selection.Value
        End With
    End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "liste" Then
        With Sheets("Feuil3")
            memo1 = Selection.Address
            .Range(memo1).Value = Selection.Value
        End With
    End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name <> "liste" Then Exit Sub
    With Sheets("Feuil3")
        memo1 = Target.Address
        .Range(memo1).Value = Target.Value
    End With
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim I As Integer
If Sh.Name <> "liste" Then Exit Sub
With Sheets("modifications")
    L = .Range("A65536").End(xlUp).Row + 1
    I = 0
    For Each Cellule In Sheets("liste").Range(memo1)
        .Range("A" & L + I) = Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss")
        .Range("B" & L + I) = Cellule.AddressLocal
        .Range("C" & L + I) = Sheets("Feuil3").Range(Cellule.Address)
        .Range("D" & L + I) = Cellule.Value
        .Range("E" & L + I) = ActiveWorkbook.UserStatus
        I = I + 1
    Next Cellule
End With
End Sub

Bonne soirée

 

[JNP]

Re : Macro d'historisation des modifications

Re ,
Mais si tu veux aller plus loin, je te conseilles d'aller voir ce fil de Skoobi, que malheureusement on a pas vu depuis longtemps, et de télécharger son applicatif
Bonne soirée

 

[mikachu]

Re : Macro d'historisation des modifications

Génial merci !

J'ai juste modifié un peu la fin du coide suite à un léger bug qui m'ajoutais des lignes non modifiées.

Dim memo1 As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("Feuil3").Cells.Clear
End Sub
Private Sub Workbook_Open()
    If ActiveSheet.Name = "liste" Then
        With Sheets("Feuil3")
            memo1 = Selection.Address
            .Range(memo1).Value = Selection.Value
        End With
    End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "liste" Then
        With Sheets("Feuil3")
            memo1 = Selection.Address
            .Range(memo1).Value = Selection.Value
        End With
    End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name <> "liste" Then Exit Sub
    With Sheets("Feuil3")
        memo1 = Target.Address
        .Range(memo1).Value = Target.Value
    End With
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim I As Integer
If Sh.Name <> "liste" Then Exit Sub
With Sheets("modifications")
    L = .Range("A65536").End(xlUp).Row + 1
    I = 0
    For Each Cellule In Sheets("liste").Range(memo1)
       If Sheets("Feuil3").Range(Cellule.Address) = Cellule.Value Then GoTo line1      
        .Range("A" & L + I) = Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss")
        .Range("B" & L + I) = Cellule.AddressLocal
        .Range("C" & L + I) = Sheets("Feuil3").Range(Cellule.Address)
        .Range("D" & L + I) = Cellule.Value
        .Range("E" & L + I) = ActiveWorkbook.UserStatus
        I = I + 1
line1:
    Next Cellule
End With
End Sub

Ca répond parfaitement à mes attentes

Merci à vous, je vais creuser le fil de skoobi dès que j'aurai un peu plus de temps