Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Row > 1000 Then Exit Sub
Dim strDatei As String, strText As String
Dim strZeit As String, strUser As String, strZelle As String, strOld As String, strNew As String
Dim intFile As Integer, rng As Range
Const strDELIM As String = "|"
Const lenUser As Integer = 15
Const lenAdresse As Integer = 6
Const lenWert As Integer = 10
Const FormatZeit As String = "YYY-MM-DD hh:mm:ss"
intFile = FreeFile
With ThisWorkbook
strDatei = ThisWorkbook.Path & "\LogDatei_" & Replace(ThisWorkbook.Name, ".xlsx", "") & ".xls"
End With
Open strDatei For Append As #intFile
If LOF(intFile) = 0 Then
With Application.WorksheetFunction
strZeit = "Zeitstempel"
strZeit = strZeit & VBA.Space(.Max(0, Len(FormatZeit) - Len(strZeit)))
strUser = "User"
strUser = strUser & VBA.Space(.Max(0, lenUser - Len(strUser)))
strZelle = "Zelle"
strZelle = strZelle & VBA.Space(.Max(0, lenAdresse - Len(strZelle)))
strOld = "alter_Wert"
strOld = strOld & VBA.Space(.Max(0, lenWert - Len(strOld)))
strNew = "neuer_Wert"
strNew = strNew & VBA.Space(.Max(0, lenWert - Len(strNew)))
strText = strZeit & strDELIM & strUser & strDELIM & strZelle & strDELIM & _
strOld & strDELIM & strNew & strDELIM
End With
Print #intFile, strText
strText = String(Len(strZeit), "-") & strDELIM & String(Len(strUser), "-") & strDELIM _
& String(Len(strZelle), "-") & strDELIM _
& String(Len(strOld), "-") & strDELIM & String(Len(strNew), "-")
Print #intFile, strText
End If
For Each rng In Target.Cells
If rng.Value <> mstrOld(rng.Row, rng.Column) Then
With Application.WorksheetFunction
strZeit = Format(Now, "YYYYMMDD_hhmmss")
strZeit = strZeit & VBA.Space(.Max(0, Len(FormatZeit) - Len(strZeit)))
strUser = Environ("username")
strUser = strUser & VBA.Space(.Max(0, lenUser - Len(strUser)))
strZelle = VBA.Replace(rng.Address, "$", "")
strZelle = strZelle & VBA.Space(.Max(0, lenAdresse - Len(strZelle)))
strOld = mstrOld(rng.Row, rng.Column)
strOld = strOld & VBA.Space(.Max(0, lenWert - Len(strOld)))
strNew = IIf(rng.Value = "", "#gelöscht", rng.Value)
strNew = strNew & VBA.Space(.Max(0, lenWert - Len(strNew)))
strText = strZeit & strDELIM & strUser & strDELIM & strZelle & strDELIM & _
strOld & strDELIM & strNew
End With
Print #intFile, strText
End If
Next
Close #intFile
End Sub