Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

[DocAElstein]

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 :

'   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 :

            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