Thema Datum  Von Nutzer Rating
Antwort
Rot Makro hindert andere Dateien am Öffnen
22.12.2022 22:21:06 Eric
NotSolved
23.12.2022 17:42:43 Gast58635
NotSolved

Ansicht des Beitrags:
Von:
Eric
Datum:
22.12.2022 22:21:06
Views:
202
Rating: Antwort:
  Ja
Thema:
Makro hindert andere Dateien am Öffnen

Hallo,

Ich habe aus diesem Forumsbeitrag den Code genommen, um ein Makro mit einem Tastatur Shortcut zu starten, auch wenn Excel gerade nur im Hintergrund ausgeführt wird: https://chandoo.org/forum/threads/running-macro-with-excel-minimised-in-background-not-active.29466/
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 das Makro und wartet auf den Shortcut, 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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro hindert andere Dateien am Öffnen
22.12.2022 22:21:06 Eric
NotSolved
23.12.2022 17:42:43 Gast58635
NotSolved