Protokoll - Code-Fehler | HERBERS Excel Forum

Hallo,
ich habe diese Frage schon in einem meiner Threads gestellt, allerdings wird dies langsam zu unübersichtlich dort. Außerdem ist es ein anderer Fehler, als im Thread besprochen wurde.
Ich habe mir einen Protokollierungs Code schreiben lassen, der es mir ermöglicht, Änderungen zu protokollieren.
Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ErsteFreieZeile As Long
Dim AlterWert As Variant, NeuerWert As Variant
Dim rngNeuSel As Range
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("A1:AN2000")) Is Nothing Then Exit Sub
'Ereignisbehandlung ausschalten:
Application.EnableEvents = False
'Zwischenspeichern des neuen Wertes und der neuen Zellmarkierung
NeuerWert = Target.Value
Set rngNeuSel = Selection
'Rückgängigmachen der letzten Aktion (=Zellwertänderung und Zellmarkierung):
Application.Undo '

Allerdings treten einige Probleme auf. An sich funktioniert der Code, doch anscheinend stört er anderweitig das arbeiten.
Fehler 1: Wenn ich manuell eine neue Zeile einfügen will, kommt der "Laufzeitfehler '424': Objekt erforderlich." Wenn ich es beende, statt zu Debuggen, kann ich aber eine Zeile einfügen. beim Debuggen werde ich auf den angegebenen Code geleitet und er markiert mir "AlterWert=Target.Value".
Fehler 2: Ich habe einen Code, der mir einen neuen Eintrag automatisch setzt.
Code:
Option Explicit
Sub Main()
Dim lngLastRow As Long
Dim strTMP As String
Dim i As Long
On Error GoTo Fin
With Tabelle1
lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = lngLastRow To 1 Step -1
If InStr(1, .Cells(i, 2), "(") 0 Then Exit For
Next i
i = i + 1
.Rows(i).Insert
lngLastRow = i - 1
strTMP = Split(Split(.Cells(lngLastRow, 2).Value, "(")(1), ")")(0)
If Left(strTMP, 2) = "00" Then
strTMP = "00" & strTMP + 1
ElseIf Left(strTMP, 1) = 0 Then
strTMP = "0" & strTMP + 1
Else
strTMP = strTMP + 1
End If
If Len(strTMP) > 3 Then strTMP = Right(strTMP, 3)
.Cells(lngLastRow + 1, 2).Value = "(" & strTMP & ")_ "
Application.Goto .Cells(lngLastRow + 1, 2), True
SendKeys "{F2}"
End With
Fin:
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Hier bekomme ich den "Laufzeitfehler '1004': Die Methode 'Undo' für das Objekt '_Application' ist fehlgeschlagen. Auch das kann ich beenden, und das Makro wieder ganz normal ausführen. Beim debuggen werd ich auf den Protokollierungs-Code geleitet und mir wird "Application.Undo" markiert.
Fehler 3: Ich kann keine Zeilen löschen ! Nach dem Löschen, tauchen sie einfach wieder auf ! Ich habe gelesen, das liegt an der Undo Zeile. Aber das darf ja so nicht passieren !
Ich weiß, das sind sehr viele Fragen auf einmal ! Aber trotzdem hoffe ich, dass ihr mir helfen könnt !
Danke :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
dann teste mal (Mappe vorher einmal schließen und wieder öffnen):

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private avntOldValues As Variant

Private Sub Workbook_Open()
    Call ReadValues
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call ReadValues
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim lngFirstFreeRow As Long
    Dim rngCell As Range, rngRange As Range

    If Sh.Name <> "Protokoll" Then

        Set rngRange = Intersect(Target, Sh.Range("A1:AN2000"))

        If Not rngRange Is Nothing Then

            'Ereignisbehandlung ausschalten:
            Application.EnableEvents = False

            With Worksheets("Protokoll")

                lngFirstFreeRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

                For Each rngCell In rngRange

                    .Cells(lngFirstFreeRow, 1).Value = Sh.Name
                    .Cells(lngFirstFreeRow, 2).Value = rngCell.Address(False, False)
                    .Cells(lngFirstFreeRow, 3).Value = rngCell.Value
                    .Cells(lngFirstFreeRow, 4).Value = avntOldValues(rngCell.Row, rngCell.Column)
                    .Cells(lngFirstFreeRow, 5).Value = Date
                    .Cells(lngFirstFreeRow, 6).Value = Time
                    .Cells(lngFirstFreeRow, 7).Value = Environ("USERNAME")

                    lngFirstFreeRow = lngFirstFreeRow + 1

                Next
            End With

            Set rngRange = Nothing

            'Ereignisbehandlung wieder einschalten:
            Application.EnableEvents = True

        End If
    End If
End Sub

Private Sub ReadValues()
    avntOldValues = ActiveSheet.Range("A1:AN2000").Value
End Sub

Ist halt erheblich langsamer als eine externe Datei und die "Rückgängig machen" - Funktion von Excel funktioniert nicht mehr.
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Protokoll - Code-Fehler

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread