This is post 104https://www.excelfox.com/forum/showt...ll=1#post17969
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=17969&viewfull=1#post17969
https://www.excelfox.com/forum/showt...ge11#post17969
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11#post17969
Jaf: Can you try this other code :
Code:
' https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/page-2#post-5228787
' Can you try this other code :
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 big_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 Alle löschen La légende du bouton", 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
If the above doesn't work for you either, can you tell me if you get an error and on which line ?
Yaz: I got an error "Object doesn't support this property or method 'Error 438' "
at this line
Call oIA.accDoDefaultAction(vKid)
Alan 2024: This coding appeared very similar to my final offering in 2019. To make a better comparison I have made changes, mostly in coding layout in the coding above, and in an updated version of "mine"** With those changes, they are almost identical .
My findings have been discussed already, (
)
I had similar findings to Yasser, - the problem seemed to be that we could not get it to work in Office 2016
Jaf: Try adding a MsgBox to the code :
Code:
If InStr("Clear All - Borrar todo - Effacer tout", oIA.accName(vKid)) Then
MsgBox vKid
Call oIA.accDoDefaultAction(vKid): CommandBars("Office Clipboard").Visible = Not bHidden: bHidden = False: Exit Sub
End If
What value does the MsgBox show ?
Yaz: The value of vKid is 0
Jaf: I am afraid, I don't have excel 2016 for testing -- The two codes I have posted work fine in excel 2007 , 2010 and 2013
Reply With Quote
Bookmarks