|
Moin allerseits, an meinen Tabellen arbeiten mehrere Menschen, was oft dazu führt, dass etwas (vielleicht unabsichtlich) geändert wird. Das möchte ich gerne protokollieren und den Großteil hab ich bereits geschafft. Trotzdem gibt's jetzt Probleme, falls ich damit arbeite:
1. Wenn ich etwas ausschneide und wieder einfüge wird nichts eingefügt (im selben Arbeitsblatt) und in einem anderen stimmt der Wert nicht mehr (zum Beispiel wird im Blatt1 die '54' zu einer '9' im Blatt 2). Ich möchte allerdings nicht auf das Ausschneiden verzichten und somit fällt selection.cut weg
2. Sollte ich mehrere Zellen auf einmal bearbeiten, z.B. in einer Spalte immer den Wert 15000 stehen haben will und den runter ziehe, wird das nicht dokumentiert
3. Es wird ebenfalls nicht dokumentiert, falls der Blattname geändert wird. Brauchbar wäre eine Zelle mit "alter Blattname" und "neuer Blattname" falls er geändert wird
Hier ist schon mal mein Code, vielleicht findet sich ja jemand der mit weiter helfen möchte?
Vielen Dank schonmal! Gruß
Private Sub Workbook_SheetChange(ByVal Sh as Object, ByVal Target As Range)
Sheets("Protokoll").Unprotect 123
Dim FirstFreeRow As Long
Dim OldVal As Variant
Dim NewVal As Variant
Dim rngNewSel As Range
User = Application.UserName
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("A1:Z999")) Is Nothing Then Exit Sub
Application.EnableEvents = False
NewVal = Target.Value
Set rngNewSel = Selection
Application.Undo
OldVal = Target.Value
Target.Value = NewVal
On Error Resume Next
rngNewSel.Activate
On Error GoTo 0
With Sheets("Protokoll")
FirstFreeRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(FirstFreeRow, 1) = Sh.Name
.Cells(FirstFreeRow, 2) = Target.Address(0, 0)
.Cells(FirstFreeRow, 3) = OldVal
.Cells(FirstFreeRow, 4) = Target.Value
.Cells(FirstFreeRow, 5) = Date
.Cells(FirstFreeRow, 6) = Time
.Cells(FirstFreeRow, 7) = User
End With
Application.EnableEvents = True
Sheets("Protokoll").Protect 123
End Sub
|