IIRC for Office 2013 or later, you need to use CommandBars("Office Clipboard") rather than CommandBars("Task Pane")
You can also reduce the code (courtesy of Jaafar Tribak) to:
Code: Select all
Option Explicit
Private Type POINTAPI
x As Long
Y As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
#If VBA7 Then
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
Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#If Win64 Then
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
#Else
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
#End If
Dim hwndClip As LongPtr
Dim hwndScrollBar As LongPtr
Dim lngPtr As LongPtr
#Else
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
Dim hwndClip As Long
Dim hwndScrollBar As Long
#End If
Const GW_CHILD = 5
Const S_OK = 0
Sub ClearOfficeClipBoard()
Dim tRect1 As RECT, tRect2 As RECT
Dim tPt As POINTAPI
Dim oIA As IAccessible
Dim vKid As Variant
Dim lResult As Long
Dim i As Long
Static bHidden As Boolean
If CommandBars("Office Clipboard").Visible = False Then
bHidden = True
CommandBars("Office Clipboard").Visible = True
Application.OnTime Now, "ClearOfficeClipBoard": Exit Sub
End If
hwndClip = FindWindowEx(Application.hwnd, 0, "EXCEL2", vbNullString)
hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars("Office Clipboard").NameLocal)
hwndClip = GetNextWindow(hwndClip, GW_CHILD)
hwndScrollBar = GetNextWindow(GetNextWindow(hwndClip, GW_CHILD), GW_CHILD)
If hwndClip And hwndScrollBar Then
GetWindowRect hwndClip, tRect1
GetWindowRect hwndScrollBar, tRect2
BringWindowToTop Application.hwnd
For i = 0 To tRect1.Right - tRect1.Left Step 50
tPt.x = tRect1.Left + i: tPt.Y = tRect1.Top - 10 + (tRect2.Top - tRect1.Top) / 2
#If VBA7 And Win64 Then
CopyMemory lngPtr, tPt, LenB(tPt)
lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
#Else
lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
#End If
If InStr("Clear All - Borrar todo - Effacer tout", oIA.accName(vKid)) Then
Call oIA.accDoDefaultAction(vKid): CommandBars("Office Clipboard").Visible = Not bHidden: bHidden = False: Exit Sub
End If
DoEvents
Next i
End If
CommandBars("Office Clipboard").Visible = Not bHidden
MsgBox "Unable to clear the Office Clipboard"
End Sub