Zwei unterschiedliche Private Sub Workbook_Sheet..
15.01.2015 08:26:00
Alex
ich fürchte, dass ich bei einer Kombination aus zwei VBA-Codes nicht weiterkomme.
Ich habe einen Urlaubsplaner auf der Arbeit.
Bei diesem habe ich den Code (aus dem Netz) eingebettet, der die Datei nach 10 unbenutzten Minuten automatisch schließt.
Link: http://www.office-loesung.de/ftopic442760_0_0_asc.php
Code in der Arbeitsmappe:
==================================================
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
End Sub
Private Sub Workbook_Open()
dteCloseTime = Now + TimeSerial(0, 9, 0)
Application.OnTime dteCloseTime, "DoClose"
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 9, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 9, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 9, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
================================================
Zusätzlicher Code für die Meldung im Modul:
================================================
Option Explicit
Public dteCloseTime As Date, blnCloseNow As Boolean
Public Sub DoClose()
Dim strMsg As String
If blnCloseNow = False Then
strMsg = "Diese Datei wurde seit 9 Minuten nicht bearbeitet und" & vbCrLf & _
"wird bei weiterer Inaktivität in 1 Minute geschlossen."
CreateObject("WScript.Shell").PopUp strMsg, 10, ThisWorkbook.Name, _
vbOKOnly + vbInformation + vbSystemModal
blnCloseNow = True
dteCloseTime = Now + TimeSerial(0, 1, 0)
Application.OnTime dteCloseTime, "DoClose"
Else
If Workbooks.Count = 1 Then
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
Application.Quit
Else
ThisWorkbook.Close True
End If
End If
End Sub
================================================
Danach wollte ich noch in einer zusätzlichen Tabelle noch einen Protokoll laufen lassen, denn ich gerne ausblenden würde. Diesen Code habe ich von Ihnen.
Link: https://www.herber.de/forum/archiv/1320to1324/1320137_Protokoll_mit_VBA_erstellen.html
================================================
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
================================================
Auch diesen Code wollte ich in die Arbeitsmappe kopieren.
Leider bekomme ich ständig einen Fehler, weil ich zwei "Privat Sub Workbook_SheetChange" an unterschiedlichen Stellen getrennt nutze. Habe versucht einen Code in den anderen einzuarbeiten. Leider funktionieren dann beide Makros fehlerhaft. Der eine Code schließt die Datei evtl. schon nach ein bis zwei Minuten, anstatt nach 10 Minuten. Oder das Protokoll funktioniert nicht mehr, bzw. wird nicht gefüllt.
Könnten Sie mir bei diesem Problem weiterhelfen?
Vielen Dank im Voraus.
Mit freundlichen Grüßen
Alex