AW: Daten fortlaufend weiterschreiben lassen
27.09.2011 18:07:47
Hajo_Zi
Hallo Abert,
ich habe mal vor ewigen Zeiten folgenden Code erstellt. Vielleicht ist dies ein Ansatz.
Option Explicit
Dim LoLetzte As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
With Worksheets("Tabelle3")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
Rows.Count) + 1
.Cells(LoLetzte, 1) = Target.Address
.Cells(LoLetzte, 2) = Target
.Cells(LoLetzte, 3) = Sh.Name
.Cells(LoLetzte, 4) = Environ("Username")
End With
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Sicherungen Protokollieren
With Worksheets("Tabelle3")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
Rows.Count) + 1
.Cells(LoLetzte, 1) = Now
.Cells(LoLetzte, 2) = Environ("Username")
End With
End Sub
Private Sub Workbook_Open()
' die letzten 10 Veränderungen anzeigen
Dim LoI As Long
Dim LoJ As Long
Dim StMeldung As String
With Worksheets("Tabelle3")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
Rows.Count) + 1
If LoLetzte > 10 Then LoJ = LoLetzte - 11
For LoI = LoJ + 1 To LoLetzte
StMeldung = StMeldung & .Cells(LoI, 1).Text & " " & .Cells(LoI, 2) & Chr(13)
Next LoI
MsgBox StMeldung
End With
End Sub