Possible to bind key to specific macro and have it work system-wide when excel is not the active window?

[theAphex]

So i'm in the process of working on a macro that takes a screenshot of the active window and pastes it into a spreadsheet. I was able to create a screenshot/paste macro and bind key F12 to run the macro; however, I need the ability to have the macro work outside of just Excel, with the screenshots going back to excel.

For example I would like to accomplish the following;
1. Load Macro Enabled .XLSM with macro embedded (done)
2. Bind Key F12 to the macro (done)
3. Be able to open internet explorer (or any other window), press F12 and a screenshot is taken and pasted into Excel

Is this possible?

 

[tweedle]

You would have to set a system hook to the keyboard and intercept F12 for every application.
In IE, you'e be intercepting the the Developer Tools.
Hooking anything system-wide is risky business. If you want to pursue it, search for "HookEx" family of user32 API functions.

 

[Jaafar Tribak]

You can do this without using a system-wide hook thus avoiding the risks associated with system hooking..... You just register a hotkey and watch the WM_HOTKEY message inside the window message pump using a loop.

Here is a flexible Subroutine SetHotKeyToCopyAndPasteActiveWindows which takes two arguments 1- the Key you want to hook and 2- the destination Sheet/Range where you want to paste the screenshot of any current active window outside excel.

Place this code in a standard module and run the Test Macro to automatically paste a screenshot of any active window at Cell B2 everytime you hit the F10 key :

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

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 GetMessage Lib "user32" _
    Alias "GetMessageA" _
    (lpMsg As Msg, _
    ByVal hwnd As Long, _
    ByVal wMsgFilterMin As Long, _
    ByVal wMsgFilterMax As Long) As Long

Private Declare Function PostMessage Lib "user32" _
    Alias "PostMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
Private Declare Function GetProp Lib "user32" Alias "GetPropA" _
    (ByVal hwnd As Long, _
    ByVal lpString As String) As Long

Private Declare Function SetProp Lib "user32" Alias "SetPropA" _
    (ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal hData As Long) As Long
    
Private Declare Function OpenClipboard Lib "user32" _
    (ByVal hwnd As Long) As Long
    
Private Declare Function EmptyClipboard Lib "user32" () As Long

Private Declare Function CloseClipboard Lib "user32" () As Long
    
Private Const WM_HOTKEY = &H312
Private bHotKeyRemoved As Boolean
Private bLoopRunning As Boolean


Sub test()
   Call SetHotKeyToCopyAndPasteActiveWindows(VBA.vbKeyF10, ActiveSheet.Range("B2"))
End Sub

Sub RemoveHotKey()
    bHotKeyRemoved = True
End Sub


Private Sub SetHotKeyToCopyAndPasteActiveWindows _
(ByVal HotKey As Long, ByVal PasteWhere As Range)
    Dim tMsg As Msg
    Dim lHotKeyID As Long
    
    If bLoopRunning Then Exit Sub
    bHotKeyRemoved = False
    Call UnregisterHotKey(0, GetProp(Application.hwnd, "HotKeyID"))
    lHotKeyID = 1
    SetProp Application.hwnd, "HotKeyID", lHotKeyID
    If RegisterHotKey(0, lHotKeyID, 0&, HotKey) <> 0 Then
        bLoopRunning = True
        Do While GetMessage(tMsg, 0, 0, 0) And bHotKeyRemoved = False
            bLoopRunning = True
            With tMsg
                If .message = WM_HOTKEY And .hwnd <> Application.hwnd Then
                    OpenClipboard 0&
                    EmptyClipboard
                    CloseClipboard
                    Application.SendKeys "(%{1068})", True
                    On Error Resume Next
                        PasteWhere.Parent.Paste PasteWhere
                    On Error GoTo 0
                End If
                PostMessage .hwnd, .message, .wParam, .lParam
            End With
            DoEvents
        Loop
    End If
    bLoopRunning = False
    Call UnregisterHotKey(0, GetProp(Application.hwnd, "HotKeyID"))
End Sub

Note that all keys can be hooked with this technic except F12 which is reserved by the debugger see MSDN.

 

[tweedle]

Nice bit there Jaafar.
It seems to have a delay at times and I personally don't care for the emptyclipboard w/o restore, but still a nice bit.
Incidentally, I changed the hook to F5 and now I can't refresh my pages - but I have plenty of screen-shots

 

[Jaafar Tribak]

Nice bit there Jaafar.
It seems to have a delay at times and I personally don't care for the emptyclipboard w/o restore, but still a nice bit.
Incidentally, I changed the hook to F5 and now I can't refresh my pages - but I have plenty of screen-shots

Thanks for the feedback.
The clipboard content gets lost anyway whenever a screenshot is taken as requested by the OP
To restore the hotkey initial functionality in yoor case F5 you need to run the RemoveHotKey routine otherwise closing excel restores everything back to normal.

 

[theAphex]

Thanks! Not sure why but this doesn't seem to work for me. It takes the screenshot but doesn't paste it into excel, i can paste it manually with a Control-V. Also, would it be difficult to translate this into a macro to run within Word? Screenshot active window and paste to specific word doc.