AW: Idle_Timer bei aktiver Zelle
09.09.2015 16:48:21
Marcus
Hallo ausglöst wird der Timer durch Workbook_Open und über dann alle 1000ms ihn toggled , so der Plan.
Ich habe jetzt Folgendes gefunden und im Modul1 implementiert:
Option Explicit
'=============================================================================================== _
'=============================================================================================== _
'=============================================================================================== _
Private Const Time_To_Idle As Single = 60 ' Zeit nach der ausgeloggt werden soll in Sekunden
'=============================================================================================== _
'=============================================================================================== _
'=============================================================================================== _
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare PtrSafe Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As _
Long
Public TimerID As Long
Public TimerSeconds As Single
'Sekundentakt starten
Sub StartTimer()
TimerSeconds = 1
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
'Sekundentakt beenden
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
'Inaktivität prüfen aufrufen im Sekundentakt
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As _
Long)
'Inaktivität prüfen aufrufen
Call Idle_Timer
End Sub
Function IdleTime() As Single
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTime = (GetTickCount - a.dwTime) / 1000 'Idletime in Sekunden
End Function
Sub Idle_Timer()
If IdleTime >= Time_To_Idle Then 'Vergleich Idletime mit Zeitvorgabe in Sekunden
'Sekundentakt beenden
Call EndTimer
'Arbeitsmappe speichern und schließen
ActiveWorkbook.Close savechanges:=True
End If
End Sub
Aufgerufen wird der Timer in "DieseArbeitsmappe" mit:
Option Explicit
Private Sub Workbook_Open()
'Sekundentakt starten
Call StartTimer
End Sub
Das funktioniert soweit auch, es resultiert jedoch ein Fehler von Excel mit diefferenzierendem Fehlercode.