Arbeitsblatt Script auslagern in Modul
Tom
Moin Moin,
Das Script überwacht das aktuelle Arbeitsblatt und schreibt Änderungen in ChangeLog.
Zuätzlich wird geprüft ob das aktuelle Blatt einen bestimmten Namen hat.
Wenn ja wird die Möglchkeit geboten den geänderten Wert wieder rückgängig zu machen.
Läuft stabil, möchte das aber für zukünftige Updates weg vom Blatt haben und es soll in ein Modul.
Was muss ich beachten wenn ich das in ein Modul kopiere.....
Dim oldValue As Variant ' Globale Variable, um den vorherigen Wert zu speichern
Dim continueMonitoring As Boolean ' Variable, um zu überprüfen, ob die Überwachung fortgesetzt werden soll
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Speichere den alten Wert der ausgewählten Zelle
If Target.Cells.Count = 1 Then ' Nur Einzelzellen beachten
oldValue = Target.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IntersectRange As Range
Dim logSheet As Worksheet
Dim newRow As Long
' Überprüfe, ob sich die geänderte Zelle im aktuellen verwendeten Bereich befindet
If Not Intersect(Target, Me.UsedRange) Is Nothing Then
Set IntersectRange = Intersect(Target, Me.UsedRange)
' Gib eine Meldung mit dem alten und neuen Wert aus
MsgBox "Die Zelle " & IntersectRange.Address & " wurde von '" & oldValue & "' auf '" & IntersectRange.Value & "' geändert."
' Schreibe die Änderung in das ChangeLog
Set logSheet = GetOrCreateSheet("ChangeLog")
newRow = logSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With logSheet
.Cells(newRow, 1).Value = Me.Name ' Arbeitsblatt
.Cells(newRow, 2).Value = IntersectRange.Address ' Geänderte Zelle
.Cells(newRow, 3).Value = oldValue ' Alter Wert
.Cells(newRow, 4).Value = IntersectRange.Value ' Neuer Wert
.Cells(newRow, 5).Value = Application.UserName ' Benutzername
.Cells(newRow, 6).Value = Environ("USERNAME") ' Windows-Benutzername
.Cells(newRow, 7).Value = Now ' Datum/Uhrzeit
End With
' Prüfe, ob das Arbeitsblatt den Namen "MUSTER" hat
If Me.Name = "MUSTER" Then
' Setze die Überwachung fort
continueMonitoring = True
' Frage nach der Wiederherstellung des alten Werts
Dim restoreOldValue As Integer
restoreOldValue = MsgBox("Soll der alte Wert wiederhergestellt werden?", vbYesNo)
If restoreOldValue = vbYes Then
Application.EnableEvents = False ' Deaktiviere Ereignisverarbeitung, um Endlosschleife zu verhindern
IntersectRange.Value = oldValue ' Setze den alten Wert wieder ein
Application.EnableEvents = True ' Aktiviere Ereignisverarbeitung
End If
End If
End If
End Sub
Function GetOrCreateSheet(sheetName As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
If ws Is Nothing Then
' Das Tabellenblatt existiert nicht, also erstelle es
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = sheetName
' Füge Überschriften hinzu
With ws
.Cells(1, 1).Value = "Arbeitsblatt"
.Cells(1, 2).Value = "Geänderte Zelle"
.Cells(1, 3).Value = "Alter Wert"
.Cells(1, 4).Value = "Neuer Wert"
.Cells(1, 5).Value = "Benutzername"
.Cells(1, 6).Value = "Windows-Benutzername"
.Cells(1, 7).Value = "Datum/Uhrzeit"
End With
End If
Set GetOrCreateSheet = ws
End Function