Reset Clear ClipBoard

[YasserKhalil]

[FONT=&quot]Hello everyone[/FONT]
[FONT=&quot]I have searched a lot and tried a lot of codes for clearing the clipboard and this is one of them

[/FONT][/COLOR][COLOR=#2E8B57][FONT=Monaco]Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]Public Declare Function EmptyClipboard Lib "user32" () As Long[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]Public Declare Function CloseClipboard Lib "user32" () As Long[/FONT][/COLOR]

[COLOR=#2E8B57][FONT=Monaco]Public Function ClearClipboard()[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]    OpenClipboard (0&)[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]    EmptyClipboard[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]    CloseClipboard[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]End Function[/FONT][/COLOR]

[COLOR=#2E8B57][FONT=Monaco]Sub Test()[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]    Call ClearClipboard[/FONT][/COLOR]
[COLOR=#2E8B57][FONT=Monaco]End Sub[/FONT][/COLOR][COLOR=#333333][FONT=&quot]

[/FONT][FONT=&quot]But nothing works for me till now[/FONT]
[FONT=&quot]Any idea?

I have posted this thread at this link
[/FONT]http://www.eileenslounge.com/viewtopic.php?f=30&t=31849

But I didn't find a solution till now

I am using Office 2016 32 Bit

 

[Jaafar Tribak]

I have changed 2& to 0& to avoid error then I got 0 at the immediate window and then another error at this part

a.accName(i)

In valid procedure call or argument

Can you place an On Error Resume Next statement right before : Set a = avAcc

 

[YasserKhalil]

I just got 0 in the immediate window
And I put the line before the line of

avAcc.accDoDefaultAction 2&

and I got also 0

 

[Jaafar Tribak]

I just got 0 in the immediate window
And I put the line before the line of

avAcc.accDoDefaultAction 2&

and I got also 0

I don't know why it doesn't work in office 2016. Maybe the hierarchy of the Accessibility buttons is different from that of previous office editions --- unfortunately, I don't use excel 2016 so I could test it.

 

[Jaafar Tribak]

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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  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)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Dim hwndClip As LongPtr
    Dim hwndScrollBar As LongPtr
    Dim lngPtr As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  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
            [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 And Win64 Then
                CopyMemory lngPtr, tPt, LenB(tPt)
                lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
            [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
                lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
            [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  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

If the above doesn't work for you either, can you tell me if you get an error and on which line ?

 

[YasserKhalil]

Thanks a lot for your patience
I am wonder why none of those codes didn't work for me
I got an error "Object doesn't support this property or method 'Error 438' "
at this line

Call oIA.accDoDefaultAction(vKid)

 

[Jaafar Tribak]

Try adding a MsgBox to the code :

            If InStr("Clear All - Borrar todo - Effacer tout", oIA.accName(vKid)) Then[COLOR=#ff0000][B] 
               MsgBox vKid[/B][/COLOR]
                Call oIA.accDoDefaultAction(vKid): CommandBars("Office Clipboard").Visible = Not bHidden: bHidden = False: Exit Sub
            End If

What value does the MsgBox show ?

 

[YasserKhalil]

The value of vKid is 0

 

[Jaafar Tribak]

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

 

[YasserKhalil]

Thanks a lot for your great and awesome efforts

Is there a way or steps that I can do for you so as to clarify the issue for excel 2016 .. such as using specific program that shows the APIs of the "Clear All" button for this version?

 

[welshgasman]

Have you tried

Application.CutCopyMode=False