Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

[DocAElstein]

Code in support of these Threads:


http://www.excelfox.com/forum/showth...1018#post11018
http://www.eileenslounge.com/viewtopic.php?f=30&t=31849
https://stackoverflow.com/questions/...ently-on-the-c
https://stackoverflow.com/questions/...60767#54960767

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 ClearOffPainBouton() 'OhFolloks
'Application.DisplayClipboardWindow = True
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
Dim MyPain As String 'COMsOLEwollupsActivelyEmmbeddedXratedObjectHookMyBoutonOhFolloks
    If CLng(Val(Application.Version)) <= 11 Then
     Let MyPain = "Task Pane"
    Else
     Let MyPain = "Office Clipboard"
    End If
    If CommandBars(MyPain).Visible = False Then
     bHidden = True
     CommandBars(MyPain).Visible = True
     Application.OnTime Now + TimeValue("00:00:01"), "ClearOffPainBouton": Exit Sub
    End If

Let hwndClip = FindWindowEx(Application.hWnd, 0, "EXCEL2", vbNullString)
Let hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars(MyPain).NameLocal)
Let hwndClip = GetNextWindow(hwndClip, GW_CHILD)
Let 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)
             Let lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
            #Else
             Let lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
            #End If ' ##### avec moi si vou ple La légende du bouton
            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(MyPain).Visible = Not bHidden: bHidden = False: Exit Sub
            End If
         DoEvents
        Next i
    End If
 Let CommandBars(MyPain).Visible = Not bHidden
 MsgBox "Unable to clear the Office Clipboard"
End Sub

Sub TestVersion() ' Rory Archibald 2015
 MsgBox prompt:=ExcelVersion
 MsgBox prompt:=CLng(Val(Application.Version))
End Sub
Private Function ExcelVersion() As String
    Dim Temp                  As String

    'On Error Resume Next
#If Mac Then
    Select Case CLng(Val(Application.Version))
        Case 11: Temp = "Excel 2004"
        Case 12: Temp = "Excel 2008" ' this should NEVER happen!
        Case 14: Temp = "Excel 2011"
        Case 15: Temp = "Excel 2016 (Mac)"
        Case Else: Temp = "Unknown"
    End Select
#Else
    Select Case CLng(Val(Application.Version))
        Case 9: Temp = "Excel 2000"
        Case 10: Temp = "Excel 2002"
        Case 11: Temp = "Excel 2003"
        Case 12: Temp = "Excel 2007"
        Case 14: Temp = "Excel 2010"
        Case 15: Temp = "Excel 2013"
        Case 16: Temp = "Excel 2016 (Windows)"
        Case Else: Temp = "Unknown"
    End Select
#End If
#If Win64 Then
    Temp = Temp & " 64 bit"
#Else
    Temp = Temp & " 32 bit"
#End If

    ExcelVersion = Temp
End Function