Änderungshistorie; Undo Fehler

Private Sub Worksheet_Change(ByVal Target As Range) 'CR Const xRg As String = "A1:AQ1000" Dim strOld As String Dim strNew As String Dim strCmt As String Dim xLen As Long With Target(1) If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub strNew = .text Application.EnableEvents = True Application.Undo strCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & _ Application.UserName & Chr(10) & "Previous Text :- " & strOld If Target(1).Comment Is Nothing Then .AddComment Else xLen = Len(.Comment.Shape.TextFrame.Characters.text) End If With .Comment.Shape.TextFrame .AutoSize = True .Characters(Start:=xLen + 1).Insert IIf(xLen, vbLf, "") & strCmt End With End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) 'CR On Error GoTo Fehler Const xRg As String = "A1:AQ1000" Dim strOld As String Dim strNew As String Dim strCmt As String Dim xLen As Long With Target(1) If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub strNew = .Text Application.EnableEvents = False Application.Undo Application.EnableEvents = True strCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & _ Application.UserName & Chr(10) & "Previous Text :- " & strOld If Target(1).Comment Is Nothing Then .AddComment Else xLen = Len(.Comment.Shape.TextFrame.Characters.Text) End If With .Comment.Shape.TextFrame .AutoSize = True .Characters(Start:=xLen + 1).Insert IIf(xLen, vbLf, "") & strCmt End With End With '*** Fehlerbehandlung Err.Clear On Error GoTo Fehler Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Danke für die schnell Hilfe, leider erscheint die Fehlermeldung immer noch.
Man muss noch dazu sagen, dass die Fehlermeldung nur erscheint, wenn ich eine Funkion in der Excel Tabelle, wie zum Beispiel "eine neue Zeile einfügen".
Komplett sieht es derzeit so aus.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B$2:$D$2" Then Call FilterLoeschen
If Target.Address = "$F$2:$J$2" Then Call ZeileEinfuegen
If Target.Address = "$K$2:$N$2" Then Call Del_Row
If Target.Address = "$O$2" Then Call Sortieren
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'CR
Const xRg As String = "A1:Z1000"
Dim strOld As String
Dim strNew As String
Dim strCmt As String
Dim xLen As Long
With Target(1)
If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub
strNew = .text
Application.EnableEvents = False
Application.Undo
strOld = .text
.Value = strNew
Application.EnableEvents = True
strCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & _
Application.UserName & Chr(10) & "Previous Text :- " & strOld
If Target(1).Comment Is Nothing Then
.AddComment
Else
xLen = Len(.Comment.Shape.TextFrame.Characters.text)
End If
With .Comment.Shape.TextFrame
.AutoSize = True
.Characters(Start:=xLen + 1).Insert IIf(xLen, vbLf, "") & strCmt
End With
End With
Err.Clear
On Error GoTo Fehler
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Änderungshistorie; Undo Fehler

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread