Makro per Shortcut bei minimiertem Fenst
22.12.2022 17:35:07
Eric
Dort kann ich leider nicht posten, deshalb hoffe ich auf Hilfe hier.
Ich habe den Code in mein Projekt integriert, hier eine Beispieldatei ohne anderen Code:
https://www.herber.de/bbs/user/156899.xlsm
Der eigentliche Zweck funktioniert. Beim Öffnen des Worbooks wird der Code gestartet, eine MsgBox zeigt es mir an. Drücke ich auf der Tastatur nun Alt+L, erscheint eine andere MsgBox, um anzuzeigen, dass das Shortcut erkannt wurde. Das funktioniert auch bei minimiertem Excel.
Problem: läuft der Code, kann ich keine anderen Excel Dateien mehr öffnen. Der Code scheint das zu unterdrücken. Der grüne Excel-Startscreen bleibt auch auf "Öffnen [Dateiname] 100%", bis eine MsgBox öffnet (an meiner Beispieldatei nur sichtbar, wenn man die MsgBox im Sub Workbook_Open auskommentiert.
Hat jemand eine Idee, wie man das Problem beheben kann? Erkennt jemand den Fehler?
Der Code:
Option Explicit
'API für Shortcut
Private Type POINTAPI
x As Long
y As Long
End Type
#If VBA7 Then
Private Type MSG
hWnd As LongPtr
message As Long
wParam As LongPtr
lParam As LongPtr
time As Long
pt As POINTAPI
End Type
Private Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hWnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hWnd As LongPtr, ByVal id As Long) As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
#Else
Private Type MSG
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
#End If
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Public message As String
Public bCancel As Boolean '============================================================
''''''''''''''''''' Code Shortcut ende
Sub Workbook_Open()
'Hook the keys combination.
bCancel = False
MsgBox "gestartet"
Call RegisterHotKey(Application.hWnd, &HBFFF&, MOD_ALT, vbKeyL)
'Application.Wait Now + #12:00:10 AM#
Call Key_Listener
End Sub
'Code für Shortcut
Sub Key_Listener()
'Dim message As MSG
Dim message As MSG
On Error GoTo Oops
Do While Not bCancel
WaitMessage
If PeekMessage(message, Application.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
'Comment out this line if you don't wish to activate excel.
VBA.AppActivate Application.Caption
Select Case message.wParam
Case &HBFFF&
Application.WindowState = xlMaximized
MsgBox "yo"
End Select
End If
DoEvents
Loop
Oops:
Call UnregisterHotKey(Application.hWnd, &HBFFF&)
Call UnregisterHotKey(Application.hWnd, &HBFFE&)
End Sub
' gheört auch zu Shortcut
Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
bCancel = True
End Sub