Code:
Option Explicit
Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hWnd As Long, ByVal dwId As Long, _
riid As tGUID, ppvObject As Object) As Long
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
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent _
As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpClass As String, ByVal lpCaption As String) As Long
Const CHILDID_SELF = 0&
Const ROLE_PUSHBUTTON = &H2B&
Const WM_GETTEXT = &HD
Type tGUID
lData1 As Long
nData2 As Integer
nData3 As Integer
abytData4(0 To 7) As Byte
End Type
Type AccObject
objIA As IAccessible
lngChild As Long
End Type
Dim lngChild As Long
Dim strClass As String
Dim strCaption As String
'Using Active Accessibility to clear Office clipboard
'Assumption:
'this is running within Word or Excel as a macro, thus the global Application object is available
Sub ClearOfficeClipboard()
Static accButton As AccObject
If accButton.objIA Is Nothing Then '-----
Dim fShown As Boolean, FeelMyPain As String:
If CLng(Val(Application.Version)) <= 11 Then ' Case 11: "Excel 2003" Windows "Excel 2004" mac
Let FeelMyPain = "Task Pane"
Else
Let FeelMyPain = "Office Clipboard"
End If
fShown = CommandBars(FeelMyPain).Visible ' False will mean the viewer pain is not open
If Not (fShown) Then
CommandBars(FeelMyPain).Enabled = True
CommandBars(FeelMyPain).Visible = True
End If
Let accButton = FindAccessibleChildInWindow(GetOfficeClipboardHwnd(Application), "Clear All", ROLE_PUSHBUTTON) ' For English Office
If accButton.objIA Is Nothing Then Let accButton = FindAccessibleChildInWindow(GetOfficeClipboardHwnd(Application), "Alle löschen", ROLE_PUSHBUTTON) ' For German Office - strangely this does not appear to help in this particular coding
End If '----------------------------------
If accButton.objIA Is Nothing Then
MsgBox "Unable to locate the ""Clear All"" button!"
Else
accButton.objIA.accDoDefaultAction accButton.lngChild ' This appears to do the clearing, but note it sets off all the other functions
End If
End Sub
' Works 2007 english
' Not work 2003, 2013, 2010 2017 German
'Retrieve window class name
Function GetWndClass(ByVal hWnd As Long) As String
Dim buf As String
Dim retval As Long
buf = Space(256)
retval = GetClassName(hWnd, buf, 255)
GetWndClass = Left(buf, retval)
End Function
'Retrieve window title
Function GetWndText(ByVal hWnd As Long) As String
Dim buf As String
Dim retval As Long
buf = Space(256)
retval = SendMessage(hWnd, WM_GETTEXT, 255, buf)
GetWndText = Left(buf, InStr(1, buf, Chr(0)) - 1)
End Function
'The call back function used by EnumChildWindows
Function EnumChildWndProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Dim found As Boolean
EnumChildWndProc = -1
If strClass > "" And strCaption > "" Then
found = StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0 And _
StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0
ElseIf strClass > "" Then
found = (StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0)
ElseIf strCaption > "" Then
found = (StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0)
Else
found = True
End If
If found Then
lngChild = hChild
EnumChildWndProc = 0
Else
EnumChildWndProc = -1
End If
End Function
'Find the window handle of a child window based on its class and titie
Function FindChildWindow(ByVal hParent As Long, Optional cls As String = "", Optional title As String = "") As Long
lngChild = 0
strClass = cls
strCaption = title
EnumChildWindows hParent, AddressOf EnumChildWndProc, 0
FindChildWindow = lngChild
End Function
'Retrieve the IAccessible interface from a window handle
'Reference:Jean Ross,Chapter 17: Accessibility in Visual Basic,Advanced Microsoft Visual Basic 6.0, 2nd Edition
Function IAccessibleFromHwnd(hWnd As Long) As IAccessible
Dim oIA As IAccessible
Dim tg As tGUID
Dim lReturn As Long
' Define the GUID for the IAccessible object
' {618736E0-3C3D-11CF-810C-00AA00389B71}
With tg
.lData1 = &H618736E0
.nData2 = &H3C3D
.nData3 = &H11CF
.abytData4(0) = &H81
.abytData4(1) = &HC
.abytData4(2) = &H0
.abytData4(3) = &HAA
.abytData4(4) = &H0
.abytData4(5) = &H38
.abytData4(6) = &H9B
.abytData4(7) = &H71
End With
' Retrieve the IAccessible object for the form
lReturn = AccessibleObjectFromWindow(hWnd, 0, tg, oIA)
Set IAccessibleFromHwnd = oIA
End Function
'Recursively looking for a child with specified accName and accRole in the accessibility tree
Function FindAccessibleChild(oParent As IAccessible, strName As String, lngRole As Long) As AccObject
Dim lHowMany As Long
Dim avKids() As Variant
Dim lGotHowMany As Long, i As Integer
Dim oChild As IAccessible
FindAccessibleChild.lngChild = CHILDID_SELF
If oParent.accChildCount = 0 Then
Set FindAccessibleChild.objIA = Nothing
Exit Function
End If
lHowMany = oParent.accChildCount
ReDim avKids(lHowMany - 1) As Variant
lGotHowMany = 0
If AccessibleChildren(oParent, 0, lHowMany, avKids(0), lGotHowMany) <> 0 Then
MsgBox "Error retrieving accessible children!"
Set FindAccessibleChild.objIA = Nothing
Exit Function
End If
'To do: the approach described in http://msdn.microsoft.com/msdnmag/issues/0400/aaccess/default.aspx
' are probably better and more reliable
On Error Resume Next
For i = 0 To lGotHowMany - 1
If IsObject(avKids(i)) Then
If StrComp(avKids(i).accName, strName) = 0 And avKids(i).accRole = lngRole Then
Set FindAccessibleChild.objIA = avKids(i)
Exit For
Else
Set oChild = avKids(i)
FindAccessibleChild = FindAccessibleChild(oChild, strName, lngRole)
If Not FindAccessibleChild.objIA Is Nothing Then
Exit For
End If
End If
Else
If StrComp(oParent.accName(avKids(i)), strName) = 0 And oParent.accRole(avKids(i)) = lngRole Then
Set FindAccessibleChild.objIA = oParent
FindAccessibleChild.lngChild = avKids(i)
Exit For
End If
End If
Next i
End Function
Function FindAccessibleChildInWindow(hwndParent As Long, strName As String, lngRole As Long) As AccObject
Dim oParent As IAccessible
Set oParent = IAccessibleFromHwnd(hwndParent)
If oParent Is Nothing Then
Set FindAccessibleChildInWindow.objIA = Nothing
Else
FindAccessibleChildInWindow = FindAccessibleChild(oParent, strName, lngRole)
End If
End Function
'Retrieve the window handle of the task pane
Function GetOfficeTaskPaneHwnd(app As Object) As Long
GetOfficeTaskPaneHwnd = FindChildWindow(app.hWnd, _
"MsoCommandBar", Application.CommandBars("Task Pane").NameLocal)
End Function
'Retrieve the window handle of the clipboard child window inside task pane
'The window title of the clipboard window seems to be language independent,
'making it a better start point to searching our UI element than the task pane window
Function GetOfficeClipboardHwnd(app As Object) As Long
GetOfficeClipboardHwnd = FindChildWindow(app.hWnd, , "Collect and Paste 2.0")
End Function
Originally Posted by rory post_id=246738 time=1550498216 user_id=83
Reply With Quote
Bookmarks