AW: Tabellenende erreicht - neues Tabellensheet
04.03.2012 15:09:44
Albert
Hallo Sepp,
das is net schwierig. Ich füg ihn hier gleich an.
Option Explicit
Dim LoLetzte As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim Netzwerk As Object
Set Netzwerk = CreateObject("wscript.network")
With Worksheets("History")
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")
.Cells(LoLetzte, 5) = CStr(Date)
.Cells(LoLetzte, 6) = CStr(Time)
.Cells(LoLetzte, 7) = Netzwerk.computername
.Cells(LoLetzte, 8) = Netzwerk.UserName
End With
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Sicherungen Protokollieren
Dim objsh As Object
Dim bolSaved
bolSaved = Me.Saved
With Worksheets("History")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
_
Rows.Count) + 1
.Cells(LoLetzte, 1) = "Speichervorgang beim Schließen"
End With
Me.Sheets("Startseite").Visible = xlSheetVisible
For Each objsh In Me.Sheets
If objsh.Name "Startseite" Then objsh.Visible = xlSheetVeryHidden
Next
If bolSaved Then Me.Save
End Sub
Private Sub Workbook_Open()
' die letzten 10 Veränderungen anzeigen
Dim LoI As Long
Dim LoJ As Long
Dim StMeldung As String
Dim objsh As Object
Sheets("Startseite").Select
With Worksheets("History")
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
End With
ActiveWorkbook.Save
With Worksheets("History")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
_
Rows.Count) + 1
.Cells(LoLetzte, 1) = "Speichervorgang beim Öffnen"
Sheets("Gesamtübersicht Ausbringung").Select
End With
End Sub