Programmatically pressing WinKey + V to display the Windows (10) clipboard

[rplazzotta]

No luck with Sendkeys, so I've tried the code below, which sort of works, except that the Windows clilpboard flashes up then immediately disappears.
The Const VK_LMENU &H5B appears to work (I've tried and discarded &HA4, because when I call this function in the VBE with &HA4, it just brings up the VBE's View menu!).

I just want to display the Windows clipboard without it immediately disappearing. Any help would be greatly appreciated!

Option Explicit

Const KEYEVENTF_KEYDOWN = &H0
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VK_LMENU = &H5B '&HA4

Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Declare PtrSafe Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal cChar As Byte) As Integer

Public Function TestWinKey_V()
keybd_event VK_LMENU, 0, KEYEVENTF_KEYDOWN, 0 'press the left Win key down
keybd_event VkKeyScan(Asc("v")), 0, KEYEVENTF_KEYDOWN, 0 'press the V key down
keybd_event VkKeyScan(Asc("v")), 0, KEYEVENTF_KEYUP, 0 'release the V key
keybd_event VK_LMENU, 0, KEYEVENTF_KEYUP, 0 'release the left Win key
End Function

[/CODE)

 

[Jaafar Tribak]

That code worked fine for me in Win10. The Windows clipboard stayed on the screen and didn't disappear.

Try this SendInput alternative to the less reliable keybd_event api and see how it goes:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SendInput Lib "user32.dll" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
#End If

Private Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As LongPtr
    #If Win64 Then
        padding As LongPtr
    #End If
End Type

Private Type tagINPUT
    INPUTTYPE As Long
    ki As KEYBDINPUT
End Type

Sub TestWinKey_V_2()

    Const KEYEVENTF_KEYUP = &H2, KEYEVENTF_UNICODE = &H4, VK_LMENU = &H5B
 
       ReDim InputArray(4&) As tagINPUT
 
       InputArray(0&).INPUTTYPE = 1&
       InputArray(0&).ki.wVk = VK_LMENU
       InputArray(0&).ki.dwFlags = KEYEVENTF_UNICODE
 
       InputArray(1&).INPUTTYPE = 1&
       InputArray(1&).ki.wVk = AscW("V")
       InputArray(1&).ki.dwFlags = KEYEVENTF_UNICODE
 
       InputArray(2&).INPUTTYPE = 1&
       InputArray(2&).ki.wVk = VK_LMENU
       InputArray(2&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
 
       InputArray(3&).INPUTTYPE = 1&
       InputArray(3&).ki.wVk = AscW("V")
       InputArray(3&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
 
       Call SendInput(4&, InputArray(0&), LenB(InputArray(0&)))

End Sub

 

[rplazzotta]

Hi Jaafar, my TestWinKey_V() function works without the clipboard disappearing (I'm calling it from the immediate window in the VBE), but only the first time in any given Windows session. All subsequent calls form the immediate window in the same Windows session display it quickly then it disappears.
Thank you for your code, I'll try it and report back
Richard

 

[rplazzotta]

Your sub TestWinKey_V_2 causes the same symptom as my TestWinKey_V on my Dell laptop (W10 64-bit build 21H1), i.e. clipboard flashes up then quickly disappears.
Very bizarre !
Also, (I forgot to tell you in my first post) that the function prints tne name of the function in the immediate window after I call it (yours does too).
It's as if both your sub and my function are returning the sub/function's name and printing it in the immediate window on the next line !

But both work as expected when I call them from any userform code (displaying the clipboard in the bottom right-hand corner of my laptop's screen, not over the userform).
Ideally, it would be nice to be able to position it at a specific screen location, maybe using API functions Findwindow, SetWindowPos, etc.

 

[Jaafar Tribak]

But both work as expected when I call them from any userform code (displaying the clipboard in the bottom right-hand corner of my laptop's screen, not over the userform).
Ideally, it would be nice to be able to position it at a specific screen location, maybe using API functions Findwindow, SetWindowPos, etc.

I have done some reading and it turns out the Windows10 Clipboard is not a classic win32 window. It is a Universal Windows Platform (UWP) app.
So programming it using classic win32 api calls can be challenging. While searching, I have come accross some code that uses special classes but I had no idea how to translate into vba.

Fortunately, Using Miicrosoft Active Accessibility MSAA along with some other api calls has yielded some interesting results and has enabled me to display the Win10 clipboard as well as to flexibly set its screen position as required.


Code concept:
Basically, the 3 optional arguments in the DisplayWindowsClip function allows for showing the clipboard and setting its position either to the left of the userform, @ the topleft of the excel application window, @ at the topleft of the active worksheet or anywhere on the screen if you use the X and Y arguments and leave out the first ParentObject argument.


WindowsClipBoard.xlsm








1- API worker code in a Standard Module:

Option Explicit
 
#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Function SendInput Lib "USER32.DLL" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
    Private Declare PtrSafe Function SetWinEventHook Lib "USER32.DLL" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As LongPtr, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWinEvent Lib "USER32.DLL" (ByVal hWinEventHook As LongPtr) As Long
    Private Declare PtrSafe Function AccessibleObjectFromEvent Lib "oleacc.dll" (ByVal hwnd As LongPtr, ByVal dwObjectId As Long, ByVal dwChildID As Long, ppacc As IAccessible, pVarChild As Variant) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any) As Long
    Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare PtrSafe Function DwmGetWindowAttribute Lib "dwmapi.dll" (ByVal hwnd As LongPtr, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SendInput Lib "USER32.DLL" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
    Private Declare Function SetWinEventHook Lib "USER32.DLL" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As LongPtr, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As LongPtr
    Private Declare Function UnhookWinEvent Lib "USER32.DLL" (ByVal hWinEventHook As LongPtr) As Long
    Private Declare Function AccessibleObjectFromEvent Lib "oleacc.dll" (ByVal hwnd As LongPtr, ByVal dwObjectId As Long, ByVal dwChildID As Long, ppacc As IAccessible, pVarChild As Variant) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any) As Long
    Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function DwmGetWindowAttribute Lib "dwmapi.dll" (ByVal hwnd As LongPtr, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    X As POINTAPI
    Y As POINTAPI
End Type

Private Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As LongPtr
    #If Win64 Then
        padding As LongPtr
    #End If
End Type

Private Type tagINPUT
    INPUTTYPE As Long
    ki As KEYBDINPUT
End Type

Private hClip As LongPtr, hEventHook As LongPtr
Private lLeft As Long, lTop As Long


Public Function DisplayWindowsClip( _
    Optional ByVal ParentObject As Object, _
    Optional ByVal X As Long = -1&, _
    Optional ByVal Y As Long = -1& _
) As Boolean
   
    Const SM_CXSCREEN = 0&, SM_CYSCREEN = 1&
    Dim tRect As RECT, hParent As LongPtr

    If Not ParentObject Is Nothing Then
        Select Case True
            Case TypeOf ParentObject Is Application
                hParent = Application.hwnd
            Case TypeOf ParentObject Is Worksheet
                hParent = FindWindowEx(Application.hwnd, NULL_PTR, "XLDESK", vbNullString)
                hParent = FindWindowEx(hParent, NULL_PTR, "EXCEL7", vbNullString)
            Case TypeOf ParentObject Is UserForm
                Call IUnknown_GetWindow(ParentObject, VarPtr(hParent))
            Case Else
                'Invalid Object Passed! Function Ret= False
                Exit Function
        End Select
        If hParent Then
            Call GetWindowRect(hParent, tRect)
            If TypeOf ParentObject Is UserForm Then
                tRect.X.X = tRect.X.X - (tRect.Y.X - tRect.X.X)
            End If
        End If
    End If
    If ParentObject Is Nothing Then
        If X = -1& Then
            tRect.X.X = (GetSystemMetrics(SM_CXSCREEN) - (GetSystemMetrics(SM_CXSCREEN) * 0.23)) / 2&
        Else
            tRect.X.X = X
        End If
        If Y = -1& Then
            tRect.X.Y = (GetSystemMetrics(SM_CYSCREEN) - (GetSystemMetrics(SM_CXSCREEN) * 0.28)) / 2&
        Else
            tRect.X.Y = Y
        End If
    End If
    Call SetClipPosition(tRect.X)
    DisplayWindowsClip = True
End Function


' _______________________________________ PRIVATE ROUTINES ______________________________________

Private Sub SetClipPosition(ByRef Pos As POINTAPI)
    lLeft = Pos.X: lTop = Pos.Y
    Call StartEventHook
End Sub
 
Private Sub StartEventHook()
    Const WINEVENT_SKIPOWNPROCESS = &H2, EVENT_OBJECT_UNCLOAKED = &H8018&
    Const DWM_CLOAKED_SHELL = &H2, DWMWA_CLOAKED = 14&
    Dim lpvAttribute As Long
   
    If hEventHook = NULL_PTR Then
        hEventHook = SetWinEventHook(EVENT_OBJECT_UNCLOAKED, EVENT_OBJECT_UNCLOAKED, 0&, _
                     AddressOf WinEventProc, 0&, 0&, WINEVENT_SKIPOWNPROCESS)
        Call LaunchWindowsClipborad
        Do
            Call DwmGetWindowAttribute(hClip, DWMWA_CLOAKED, lpvAttribute, LenB(lpvAttribute))
            DoEvents
        Loop Until hClip And lpvAttribute = DWM_CLOAKED_SHELL
        Call UnhookWinEvent(hEventHook):  hEventHook = NULL_PTR: hClip = NULL_PTR
        Debug.Print "Hook released."
    End If
End Sub
   
Private Sub WinEventProc( _
    ByVal HookId As LongPtr, _
    ByVal LEvent As Long, _
    ByVal hwnd As LongPtr, _
    ByVal idObject As Long, _
    ByVal idChild As Long, _
    ByVal idEventThread As Long, _
    ByVal dwmsEventTime As Long _
)
    Const EVENT_OBJECT_UNCLOAKED = &H8018&, S_OK = 0&
    Dim vChild As Variant, oAccDlg As IAccessible
    Dim sBuffer As String * 256&, lRet As Long
   
    On Error Resume Next
    If LEvent = EVENT_OBJECT_UNCLOAKED Then
        If AccessibleObjectFromEvent(hwnd, idObject, idChild, oAccDlg, vChild) = S_OK Then
            lRet = GetClassName(hwnd, sBuffer, 256&)
            If VBA.Left(sBuffer, lRet) = "ApplicationFrameWindow" Then
                If FindWindowEx(hwnd, NULL_PTR, "Windows.UI.Core.CoreWindow", "Microsoft Text Input Application") Then
                    hClip = hwnd
                    Sleep 25&: DoEvents
                    Call MoveWindow(hwnd, lLeft, lTop, 0&, 0&, 0&)
                End If
            End If
        End If
    End If
End Sub

Private Sub LaunchWindowsClipborad()
    Const KEYEVENTF_KEYUP = &H2, KEYEVENTF_UNICODE = &H4, VK_LMENU = &H5B
   
    ReDim InputArray(4&) As tagINPUT
   
    InputArray(0&).INPUTTYPE = 1&
    InputArray(0&).ki.wVk = VK_LMENU
    InputArray(0&).ki.dwFlags = KEYEVENTF_UNICODE
   
    InputArray(1&).INPUTTYPE = 1&
    InputArray(1&).ki.wVk = AscW("V")
    InputArray(1&).ki.dwFlags = KEYEVENTF_UNICODE
   
    InputArray(2&).INPUTTYPE = 1&
    InputArray(2&).ki.wVk = VK_LMENU
    InputArray(2&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
   
    InputArray(3&).INPUTTYPE = 1&
    InputArray(3&).ki.wVk = AscW("V")
    InputArray(3&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
   
    Call SendInput(4&, InputArray(0&), LenB(InputArray(0&)))
End Sub

2- Code Usage in UserForm Module: ( With various examples)

Option Explicit


'\\ Test1:- Show Win Clpboard to the left of the Userform.
Private Sub CommandButton1_Click()
    DoEvents
    TextBox1.SetFocus
    Call DisplayWindowsClip(Me)
End Sub


' ============================================================
'\\ Test2:- Show Win Clpboard @ TopLeft of Application Window.
'\\ ==========================================================
'Private Sub CommandButton1_Click()
'    DoEvents
'    VBA.AppActivate Application.Caption
'    Cells(1).Activate
'    Call DisplayWindowsClip(Application)
'End Sub
' ============================================================


' ============================================================
'\\ Test3:- Show Win Clpboard @ TopLeft of the excel worksheet.
'\\ ==========================================================
'Private Sub CommandButton1_Click()
'    DoEvents
'    VBA.AppActivate Application.Caption
'    Cells(1).Activate
'    Call DisplayWindowsClip(Sheet1)
'End Sub
' ============================================================


' ============================================================
'\\ Test4:- Show Win Clpboard @ Screen X,Y position (in pixels).
'\\ ==========================================================
'Private Sub CommandButton1_Click()
'    DoEvents
'    TextBox1.SetFocus
'    Call DisplayWindowsClip(, X:=100&, Y:=120&)
'End Sub
' ============================================================

I hope the code works for you as it did for me.

Regards.

 

[Dan_W]

This is amazing! Looking forward to going through the code later today.

It seems like UWP applications use those WinRT APIs I asked you about on your DLL function exporter utility thread:

UWP is one of many ways to create client applications for Windows. UWP apps use WinRT APIs to provide powerful UI and advanced asynchronous features that are ideal for internet-connected devices.

In which case, I have an update for you. Will start a thread so as not to hijack this one.