AW: Excel vor Standby schliessen
19.12.2019 17:13:35
volti
Hallo Manuel,
da mich das Thema auch interessiert, hier mal eine Möglichkeit die Inaktivität des Users über die API zu ermitteln.
Hierbei wird unterstellt, dass sämtliche manuelle Aktionen am PC ja durch Maus und Tastatur erfolgen, also nicht nur "Selection"-Change in Excel berücksichtigt wird.
Ohne Ermittlung des aktiven Fensters werden allerdings auch Aktionen anderer Anwendungen, außerhalb Excel miteinbezogen.
Nicht unterstützt wird bei aktivierten Timer/Tool das schrittweise Durchsteppen (F8) im Einzelschritt; also beim Testen von Makros das Tool eher abschalten.
Die Alternative mit dem Buildin-Befehl Application.OnTime zu arbeiten, funktioniert zwar auch, läßt aber immer wieder die "Eieruhr" anlaufen, ist daher nicht so schön.
Die Checkzeit habe ich auf 60 Sekunden gesetzt, damit möglichst wenig Rechenzeit beansprucht wird.
PS: Über die API-Funktion "SystemParametersInfo" soll man auch den Standby-Status abfragen können. Das ist mir mit bei meiner Version leider nicht gelungen.
Falls Du noch Bedarf hast, teste einfach mal, ob der u.a. code in Deinem Sinne funktioniert:
Option Explicit
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, _
ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Type POINTAPI
X As Long
Y As Long
End Type
Public iTimerID As LongPtr
Private iZeit As Long
Private Const ciTimeOut As Long = 2 'Zeit in Minuten-Intervallen
Sub CheckInactivity(Optional ByVal hWnd As LongPtr, _
Optional ByVal uMsg As Long, _
Optional ByVal wParam As LongPtr, _
Optional ByVal lParam As Long)
Static PosOld As POINTAPI, PosNew As POINTAPI
Dim i As Integer
iZeit = iZeit + 1 'Zeit zurücksetzen
If iZeit >= ciTimeOut Then
KillTimer 0, wParam: iTimerID = 0
iZeit = 0: Call MyAction
Exit Sub
End If
GetCursorPos PosNew 'Neue Mausposition
If PosOld.X <> PosNew.X Or PosOld.Y <> PosNew.Y Then
PosOld.X = PosNew.X: PosOld.Y = PosNew.Y
iZeit = 0
End If
For i = 1 To 255 'Keyboard abfragen
If GetAsyncKeyState(i) <> 0 Then iZeit = 0: Exit For
Next i
DoEvents
If wParam = 0 Then iTimerID = SetTimer(0, 0, 60000, AddressOf CheckInactivity)
End Sub
Sub MyAction()
'Hier die Aktion,die nach Timeout erfolgen soll, programmieren
CreateObject("WScript.Shell").Popup "Timeout", 10, "Meine PopUp", vbOKOnly Or vbInformation
Rem ThisWorkbook.Close savechanges:=False
End Sub
Sub Workbook_Open()
'Check Inaktivität starten
Call CheckInactivity
End Sub
Sub Workbook_BeforeClose(Cancel As Boolean)
'Check Inaktivität beenden
KillTimer 0, iTimerID
End Sub
viele Grüße
Karl-Heinz