Danke an Tino welcher mir mit dem Code sehr viel geholfen hat. Seine Version besteht aus einem Timer, welcher die Datei nach vorgegebener Zeit schliesst, die Folgecodes ausführt und perfekt läuft
Normalerweise reicht für den Anwender 3-5 Min., Also wurde die Datei auf 5 Min. eingestellt. In der Praxis reichte es in Einzellfällen nicht und die Datei wurde ohne Vorwarnung geschlossen. Zwar speichert sich die Datei, aber unangenehm ist es doch, wenn der Teller während dem Essen weggenommen wird.
Ich habe versucht, den Timer mit einem UF zu erweitern, welches sich 20 Sekunden vor Ablauf der Vorgabezeit öffnet. Läuft auch. Der Anwender sollte jetzt die Laufzeit Verlängern können. Mein Versuch, die im Code enthaltene Sub StopTimer() und Sub StartTimer() anzusprechen funktioniert zwar, der Timer beginnt wieder von vorne, aber nach dem Schliessen der Datei ist das Chaos perfekt. Die Datei öffnet sich wieder und zwar genau sovielmal wie der Button Verlängern gedrückt wurde.
Vielen Dank wenn mir jemand helfen könnte, ich schaff das nicht.
Ich wünsche allen einen schönen Sonntag Benedikt
Diese Arbeitsmappe:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If nRunTime > 0 Then Call Schließen(True)
End Sub
Private Sub Workbook_Open()
Call StartTimer
End Sub
Modul:Option Explicit
Public nRunTime As Date
Sub StartTimer()
nRunTime = Now + TimeSerial(0, 0, 20)
Application.OnTime EarliestTime:=nRunTime, Procedure:="Verlängern"
nRunTime = Now + TimeSerial(0, 0, 40)
Application.OnTime EarliestTime:=nRunTime, Procedure:="Schließen"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=nRunTime, Procedure:="Verlängern", Schedule:=False
Application.OnTime EarliestTime:=nRunTime, Procedure:="Schließen", Schedule:=False
End Sub
Sub Schließen(Optional booCloseMode As Boolean = False)
Dim oWB As Workbook, i%
Call StopTimer
nRunTime = 0
For Each oWB In Workbooks
If UCase(oWB.Name) "PERSONAL.XLS" And UCase(oWB.Name) "PERSONAL.XLSB" Then
i = i + 1
End If
Next oWB
If Not ThisWorkbook.ReadOnly Then
Application.Run "PDFspeichern"
ThisWorkbook.Close True
End If
End Sub Sub Timerdialog()
Timer.Show
End Sub
Public Sub Verlängern()
Timerdialog
End Sub
Sub StopTimer2()Call StopTimer
Application.Run "StartTimer"
End Sub Timerdialog :
Private Sub CommandButton1_Click()
Call StopTimer2
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Call StopTimer
Call Schließen
Me.Hide
End Sub