AW: VBA Editor
25.09.2005 09:05:11
Klaus
Hallo ransi,
peinlich - nachdem ich das nochmal geprüft habe, habe ich festgestellt, dass zwar der vorher gesendete Code das "ausführende Organ" ist, der nun aber nachfolgende Code Schuld am Fehler ist. Der Editor zeigt den Fehler bei UNDo an (markiert hier im Code mit -XXX UNDO XXX-)
Es soll mit diesem Code jede Änderung in den Daten registriert werden, was natürlich auch nicht funktioniert!
Ich hoffe es hilft was!
Viele Grüße
Klaus
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intSpalte As Integer, lngZeile As Long, strBuchstabe1 As String, strBuchstabe2 As String
Dim varArray_neu As Variant, varArray_alt As Variant, intArrayspalte As Integer, strAdresse As String
Dim lngArrayzeile As Long, lngLetzteZeile As Long, varAlt As Variant, varNeu As Variant
If Sh.Name <> "Protokoll" Then
If Target.Count > 1 Then varArray_neu = Range(Target.Address) Else varNeu = Target
strAdresse = Selection.Address
With Application
.ScreenUpdating = False
.EnableEvents = False
-XXX .Undo XXX-
End With
If Target.Count > 1 Then
varArray_alt = Range(Target.Address)
Application.Undo
With Worksheets("Protokoll")
For intSpalte = Target.Column To Target.Column + Target.Columns.Count - 1
intArrayspalte = intArrayspalte + 1
lngArrayzeile = 0
For lngZeile = Target.Row To Target.Row + Target.Rows.Count - 1
lngArrayzeile = lngArrayzeile + 1
If intSpalte > 26 Then
strBuchstabe1 = Chr(intSpalte \ 26 + 64)
strBuchstabe2 = Chr(intSpalte Mod 26 + 64)
Else
strBuchstabe1 = Chr(intSpalte + 64)
strBuchstabe2 = ""
End If
lngLetzteZeile = .Cells(65536, 1).End(xlUp).Row + 1
If lngLetzteZeile = 65536 Then
lngLetzteZeile = 2
.Range("A2:E65536").ClearContents
End If
.Cells(lngLetzteZeile, 1) = Now
.Cells(lngLetzteZeile, 2) = varArray_alt(lngArrayzeile, intArrayspalte)
.Cells(lngLetzteZeile, 3) = varArray_neu(lngArrayzeile, intArrayspalte)
.Cells(lngLetzteZeile, 4) = strBuchstabe1 & strBuchstabe2 & CStr(lngZeile)
.Cells(lngLetzteZeile, 5) = Sh.Name
.Cells(lngLetzteZeile, 6) = Username
Next
Next
End With
Else
varAlt = Range(Target.Address)
Application.Undo
With Worksheets("Protokoll")
lngLetzteZeile = .Cells(65536, 1).End(xlUp).Row + 1
If lngLetzteZeile = 65536 Then
lngLetzteZeile = 2
.Range("A2:E65536").ClearContents
End If
.Cells(lngLetzteZeile, 1) = Now
.Cells(lngLetzteZeile, 2) = varAlt
.Cells(lngLetzteZeile, 3) = varNeu
.Cells(lngLetzteZeile, 4) = Target.Address(False, False)
.Cells(lngLetzteZeile, 5) = Sh.Name
.Cells(lngLetzteZeile, 6) = Username
End With
End If
Range(strAdresse).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub