Autoclose nach Zeit X - Countdown anzeigen

[Klaus]

Hallo miteinander,

ich möchte meine Datei nach Zeit X schließen wenn sie nicht benutzt wird. 
Es gibt einige Vorschläge dazu, leider passen die aber nicht auf meinen Fall:

1. Das Arbeitsblatt wird über eine Userform gefüttert. Es finden also auf dem Blatt selbst keine Aktivitäten dazu statt. Wird ein Wert in die UF eingetragen erfolgt die Übernahme auf das Arbeitsblatt per Button.  
   
2. Erfolgen nach 10Min keine Eingaben mehr in der Eingabe-UF soll eine Anzeige (weitere UF??) kommen, in der ein Countdown zu sehen ist wann die Tabelle ohne speichern geschlossen wird.
   
3. Der Countdown soll per Button deaktiviert werden können und die Zeit soll von vorn anfangen.
   
4. Ist die Eingabe-UF nicht aufgerufen soll der Countdown trotzdem zählen - und nach 10Min Inaktivität den Countdown anzeigen.
   

folgenden Code habe ich dazu gefunden:

Code:

Arbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call TimeStop
End Sub

Private Sub Workbook_Open()
   Call TimeSetting
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Call TimeStop
  Call TimeSetting
End Sub


Modul

Dim CloseTime As Date
Sub TimeSetting()
   CloseTime = Now + TimeValue("00:10:00")
   On Error Resume Next
   Application.OnTime EarliestTime:=CloseTime, _
     Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
   On Error Resume Next
   Application.OnTime EarliestTime:=CloseTime, _
     Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
   ActiveWorkbook.Close Savechanges:=True
End Sub

• Leider reagiert das so nicht auf eine Bearbeitung des Arbeitsblatt über die Eingabe-UF, da auf dem Tabellenblatt selbst keine Aktivität erfolgt.
  
• Und mir fehlt die Anzeige und die Unterbrechung des Countdowns in der Countdown-UF.
  

Wie kann man das anstellen?

viele Grüße 
Klaus

[Elex]

Hi Klaus

Beispiele dazu finden sich hier. Schau mal ob das schon ausreichend hilft.
https://www.clever-excel-forum.de/Thread...ght=ontime

Gruß Elex

[Klaus]

Guten Abend Elex,

Vielen Dank für deine Antwort.

Die Idee mit dem Mauszeiger ist nichts schlecht. Wie auch die Kommentare dazu mit der Problematik der darüber gelegten Anwendung...
Beim Test kam mir wieder, wie so oft und bei den meisten der Hilfen von Hajo, das Problem mit:
"Lib "user32"
Dazu hab ich leider keine Lösung.


Das andere Bsp ist genau das was ich derzeit verwende - nur eben, hier greifen meine zwei Probleme:
A = Eingabe über Userform, 
B = kein Countdown sichtbar

Hast du / jemand einen Tip wie ich den Countdown in die Meldung bekomme?
Das mit der Userfom kann ja zur Not über das leidige "Select" lösen...

Liebe Grüße
Klaus

[Klaus]

Guten Morgen miteinander,

hätte jemand eine Idee, wie man den hier ablaufenden Countdown in der erscheinenden Meldung sichtbar machen kann? 

Code:

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[b]


Der folgende Code gehört in ein allgemeines 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[b]

liebe Grüße 
Klaus

[Elex]

Hi Klaus

Hier mal eine Version wie ich es versuchen würde.

  Inaktiv.xlsm (Größe: 24,58 KB / Downloads: 7)

Gruß Elex

[Klaus]

Guten Abend Elex,

ich würde sagen - das ist genau so wie ich es suchte. Quasi Genial :)

Wenn man jetzt nicht das Blatt über die UF füttern würde, dann würde ein in der Zelle hängender Curser die Ausführung des Timers, bzw. der Countdown UF stoppen.
Aber dem ist in meinem Fall ja so nicht. 
Ich bin begeistert und möchte mich herzlich bedanken.

Liebe Grüße
Klaus