Hi Oliver;
It is not easy because Office clipboard cannot be handled programmatically.
You can test like that (it is much of code for a little thing, but it is the
only means of making to my knowledge):
Option Explicit
Private Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long _
, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String _
, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String _
, ByVal cch As Long) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String _
, ByRef lpiid As GUID) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(8) As Byte
End Type
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hwnd As Long, ByVal dwId As Long, riid As GUID _
, ppvObject As Object) As Long
Private Declare Function AccessibleChildren Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart As Long _
, ByVal cChildren As Long, rgvarChildren As Variant _
, pcObtained As Long) As Long
Private Type AccObject
oIA As IAccessible
hwnd As Long
End Type
Private lngChild&, sClass$, sCaption$
Function EnumChildProc&(ByVal hwnd&, ByVal lParam&)
EnumChildProc = 1
If InStr(1, WindowText(hwnd), sCaption, 1) Then
If ClassName(hwnd) = sClass Then
lngChild = hwnd
EnumChildProc = 0
End If
End If
End Function
Private Function ClassName$(ByVal hwnd&)
Dim Buffer$, Ret&
Buffer = Space(256)
Ret = GetClassName(hwnd, Buffer, Len(Buffer))
ClassName = Left$(Buffer, Ret)
End Function
Private Function WindowText$(ByVal hwnd&)
Dim Buffer$
Buffer = String(256, Chr$(0))
GetWindowText hwnd, Buffer, Len(Buffer)
WindowText = Left$(Buffer, InStr(Buffer, Chr$(0)) - 1)
End Function
Sub PasteAll()
Range("A1").Select ' Where paste all elements
Application.CommandBars(1).Controls(2).Controls(5).Execute
Dim hwnd As Long
hwnd = FindWindow(vbNullString, Application.Caption)
lngChild = 0
sCaption = "Task Pane"
sClass = "MsoCommandBar"
EnumChildWindows hwnd, AddressOf EnumChildProc, ByVal 0&
If lngChild Then
' Paste all button
Call ClipboardExec(lngChild, "Paste all")
Range("A1").Select
' Clear all button
Call ClipboardExec(lngChild, "Clear all")
End If
End Sub
' Using Active Accessibility to execute Office clipboard action
Private Function ClipboardExec(ByVal hwnd&, sName$) As Boolean
Dim oBtn As AccObject
' Get the IAccessible interface and child id
oBtn = Find_IAO(hwnd, sName)
If oBtn.oIA Is Nothing Then
MsgBox "Unable to locate the ""sName"" button !", 64
Else
oBtn.oIA.accDoDefaultAction oBtn.hwnd
ClipboardExec = True
End If
End Function
Private Function Find_IAO(ByVal hwnd&, sName$) As AccObject
Dim oParent As IAccessible
Set oParent = IA_Object(hwnd)
If oParent Is Nothing Then
Set Find_IAO.oIA = Nothing
Else
Find_IAO = Find_IAO_Child(oParent, sName)
End If
End Function
Private Function IA_Object(ByVal hwnd&) As IAccessible
' Define the GUID for the IAccessible object
Const IAccessIID = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
Dim ID As GUID, Ret As Long, oIA As IAccessible
Ret = IIDFromString(StrConv(IAccessIID, vbUnicode), ID)
' Retrieve the IAccessible object for the form
Ret = AccessibleObjectFromWindow(hwnd, 0, ID, oIA)
Set IA_Object = oIA
End Function
' Recursively looking for a child with specified
' accName and accRole in the accessibility tree
Private Function Find_IAO_Child(oParent As IAccessible _
, sName$) As AccObject
Dim lHowMany&, lGotHowMany&, i%
Dim avKids(), oChild As IAccessible
Find_IAO_Child.hwnd = 0
lHowMany = oParent.accChildCount
If lHowMany = 0 Then Set Find_IAO_Child.oIA = Nothing: Exit Function
ReDim avKids(lHowMany - 1)
lGotHowMany = 0
If AccessibleChildren(oParent, 0, lHowMany _
, avKids(0), lGotHowMany) <> 0 Then
MsgBox "Error retrieving accessible children !", 64
Set Find_IAO_Child.oIA = Nothing
Exit Function
End If
On Error Resume Next
For i = 0 To lGotHowMany - 1
If IsObject(avKids(i)) Then
If StrComp(avKids(i).accName, sName) = 0 _
And avKids(i).accRole = &H2B Then
Set Find_IAO_Child.oIA = avKids(i)
Exit For
Else
Set oChild = avKids(i)
Find_IAO_Child = Find_IAO_Child(oChild, sName)
If Not Find_IAO_Child.oIA Is Nothing Then Exit For
End If
Else
If StrComp(oParent.accName(avKids(i)), sName) = 0 _
And oParent.accRole(avKids(i)) = &H2B Then
Set Find_IAO_Child.oIA = oParent
Find_IAO_Child.hwnd = avKids(i)
Exit For
End If
End If
Next i
End Function
Regards,
MP
