VBA: verhindern Bildschirm-Abschaltung

Private Declare Sub SetThreadExecutionState Lib "kernel32.dll" (ByRef esFlags As EXECUTION_STATE) ' Parameter usage: ' check https://learn.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-setthreadexecutionstate Private Enum EXECUTION_STATE ES_SYSTEM_REQUIRED = &H1 ES_DISPLAY_REQUIRED = &H2 ES_USER_PRESENT = &H4 ES_AWAYMODE_REQUIRED = &H40& es_continuous = &H80000000 End Enum ' ist eigentlich ne SUB. So wird verhindert, dass sie direkt in der Liste der ausführbaren Makros erscheint! Public Function SystemKeepAwake() ' NO EFFECT Call SetThreadExecutionState(EXECUTION_STATE.ES_SYSTEM_REQUIRED Or _ EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ EXECUTION_STATE.es_continuous) ' NO EFFECT ' Call SetThreadExecutionState(EXECUTION_STATE.ES_SYSTEM_REQUIRED Or _ ' EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ ' EXECUTION_STATE.ES_USER_PRESENT Or _ == geht nicht, siehe obigen Doku-Link! ' EXECUTION_STATE.ES_CONTINUOUS) ' NO EFFECT ' Call SetThreadExecutionState(EXECUTION_STATE.es_system_required Or _ ' EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ ' EXECUTION_STATE.ES_AWAYMODE_REQUIRED Or _ ' EXECUTION_STATE.es_continuous) ' Dim l_state As LongPtr ' NO EFFECT ' l_state = EXECUTION_STATE.es_system_required Or _ ' EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ ' EXECUTION_STATE.es_continuous ' NO EFFECT ' l_state = EXECUTION_STATE.ES_SYSTEM_REQUIRED Or _ ' EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ ' EXECUTION_STATE.ES_AWAYMODE_REQUIRED Or _ ' EXECUTION_STATE.ES_CONTINUOUS ' Call SetThreadExecutionState(l_state) End Function ' ist eigentlich ne SUB. So wird verhindert, dass sie direkt in der Liste der ausführbaren Makros erscheint! Public Function SystemToStandard() Call SetThreadExecutionState(EXECUTION_STATE.es_continuous) End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

sub main() Call SetThreadExecutionState(EXECUTION_STATE.ES_SYSTEM_REQUIRED Or _ EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ EXECUTION_STATE.es_continuous) call diverse unterroutinen.... Call SetThreadExecutionState(EXECUTION_STATE.es_continuous) end sub

Option Explicit Private Declare Sub SetThreadExecutionState Lib "kernel32.dll" (ByRef esFlags As EXECUTION_STATE) ' Parameter usage: ' check https://learn.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-setthreadexecutionstate Private Enum EXECUTION_STATE ES_SYSTEM_REQUIRED = &H1 ES_DISPLAY_REQUIRED = &H2 ES_USER_PRESENT = &H4 ES_AWAYMODE_REQUIRED = &H40 ES_CONTINUOUS = &H80000000 End Enum Public Sub MouseInSpirals() Dim screensize As Ty_S_ScreenSize Dim x As Long, y As Long Dim i As Long Dim radius As Single Dim l_Aborted As Boolean '------------------------------------------------------------------ ' KEIN EFFEKT Call SetThreadExecutionState(EXECUTION_STATE.ES_SYSTEM_REQUIRED Or _ EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _ EXECUTION_STATE.ES_CONTINUOUS) '------------------------------------------------------------------ ' kleine Wartezeit. Sonst führt der leiseste Mausruckler zum Prozedurende WaitMilliSeconds 200 'Startpunkt: Bildschirm-Mitte! screensize = get_screensize() x = screensize.width / 2 y = screensize.height / 2 Call SetMouseCursor(x, y) Dim l_idle As Long, l_idle_max As Long l_idle_max = 0 l_idle = GetSystemIsIdleSince() l_Aborted = False Do While (l_idle >= l_idle_max) radius = 155 ' immer wieder setzen, um Rundungsproblemen aus dem Weg zu gehen i = 0 While (i 10) And (Not l_Aborted) i = i + 1 l_Aborted = move_mouse_in_spiral(x, y, radius, 0.03, 2, True) Wend i = 0 While (i 10) And (Not l_Aborted) i = i + 1 l_Aborted = move_mouse_in_spiral(x, y, radius, -0.03, 2, False) Wend l_idle_max = l_idle l_idle = GetSystemIsIdleSince() ' Call SystemKeepAwake Loop Call SetThreadExecutionState(EXECUTION_STATE.ES_CONTINUOUS) ' Call SystemToStandard '------------------------------------------------------------------ ' KEIN EFFEKT ' Call SetThreadExecutionState(EXECUTION_STATE.ES_CONTINUOUS) '------------------------------------------------------------------ End Sub

Hallo Nepumuk,
mittlerweile habe ich mir das Excel nach Hause geschickt und in Excel 2013 (64bit) auf WIN10 Home laufen lassen.
Dabei wurden mir sofort alle die DECLAREs als fehlerhaft gemeldet. Ich musste die jeweiligen SafePtr-Versionen der APIs verwenden.
Danach funktionierte es zu Hause und zwar auch gekapselt, d.h. innerhalt meiner Funktion 'SystemKeepAwake'.
Ich habe dann die gleiche Datei wieder in den Betrieb geschickt, wo ja Excel 2016 läuft. Dort funktioniert es wieder nicht.
Für alle, die mit "Excel 2013, 64bit" die Bildschirmabschaltung verhindern wollen:
Mit diesem Code geht es. Den Code habe ich in ein öffentliches Modul gepackt und die private API in der öffentlichen Funktion "SystemKeepAwake" gewrapped.
Diese könnt Ihr dann an geschickter Stelle in Euren eigenen Code einbauen und am Ende das Standardverhalten mit "SystemToStandard" wieder herstellen.
Falls noch jemand Tipps wegen 2016 hat: immer her damit. Ich höre an dieser Stelle leider auf. Das geht ab jetzt weit über meinen Horizont.
Dank nochmal an Dich Nepumuk. Auch die initiale Idee hatte ich aus einem Deiner Posts hier.
LG
Dirk


#If VBA7 Then
    Private Declare PtrSafe Function SetThreadExecutionState Lib "Kernel32.dll" (ByVal esFlags As Long) As Long
#Else
    Private Declare Function SetThreadExecutionState Lib "Kernel32.dll" (ByVal esFlags As Long) As Long
#End If
'' Parameter usage:
'' check https://learn.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-setthreadexecutionstate
 
Private Enum EXECUTION_STATE
    ES_SYSTEM_REQUIRED = &H1
    ES_DISPLAY_REQUIRED = &H2
    ES_USER_PRESENT = &H4
    ES_AWAYMODE_REQUIRED = &H40
    ES_CONTINUOUS = &H80000000
End Enum
' ist eigentlich ne SUB. So wird verhindert, dass sie direkt in der Liste der ausführbaren Makros erscheint!
Public Function SystemKeepAwake()
    
    Call SetThreadExecutionState(EXECUTION_STATE.ES_SYSTEM_REQUIRED Or _
                                 EXECUTION_STATE.ES_DISPLAY_REQUIRED Or _
                                 EXECUTION_STATE.ES_CONTINUOUS)
End Function
' ist eigentlich ne SUB. So wird verhindert, dass sie direkt in der Liste der ausführbaren Makros erscheint!
Public Function SystemToStandard()
    Call SetThreadExecutionState(EXECUTION_STATE.ES_CONTINUOUS)
End Function

Beliebteste Forumthreads (12 Monate)

VBA: verhindern Bildschirm-Abschaltung

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread