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.
Code:
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
Code:
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.
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
Bonsoir Michaku ,
A améliorer et en utilisant Feuil3 pour stocker
Code:
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
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
J'ai juste modifié un peu la fin du coide suite à un léger bug qui m'ajoutais des lignes non modifiées.
Code:
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