Klembord overvol - melding bij afsluiten

[SIZE=1]Option Explicit

Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long

Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const WM_LBUTTONDOWN As Long = &H201&
Private Const WM_LBUTTONUP As Long = &H202&

Private Type tWindow
    Parent As Long
    Handle As Long
    Class As String
    Title As String
End Type

Private atWindow() As tWindow

Private miatWindow As Long

Private Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long

    Dim lpClassName As String
    Dim lResult As Long

    miatWindow = miatWindow + 1

    ReDim Preserve atWindow(1 To miatWindow)

    lpClassName = Space(256)
    lResult = GetClassName(hwnd, lpClassName, 256)
    lpClassName = Left(lpClassName, lResult)

    With atWindow(miatWindow)
        .Handle = hwnd
        .Class = lpClassName
    End With

    EnumChildProc = 1

End Function


Public Sub ClearOfficeClipboardResolutionAndLanguageIndependent()    'alphamax_2016
'clears the office clipboard

    Dim bClipboard As Boolean
    Dim bScreenUpdating As Boolean
    Dim hDC As Long
    Dim hwnd As Long
    Dim iatWindow As Long
    Dim lDPIX As Long
    Dim lDPIY As Long
    Dim lParameter As Long

    With Application
        bClipboard = .CommandBars("Office Clipboard").Visible
        bScreenUpdating = .ScreenUpdating
        If Not bClipboard Then
            Application.CommandBars("Office Clipboard").Visible = True    'show office clipboard
        End If
        If Not bScreenUpdating Then
            .ScreenUpdating = True
        End If
    End With

    DoEvents

    hwnd = FindWindow("XLMAIN", Application.Caption)
    hwnd = FindWindowEx(hwnd, 0, "EXCEL2", "")

    EnumChildWindows hwnd, AddressOf EnumChildProc, ByVal 0&    'build windowdata tree

    For iatWindow = 1 To miatWindow
        If atWindow(iatWindow).Class = "bosa_sdm_XL9" Then    'get button
            hwnd = atWindow(iatWindow).Handle
        End If
    Next

    hDC = GetDC(0)
    lDPIX = GetDeviceCaps(hDC, LOGPIXELSX)
    lDPIY = GetDeviceCaps(hDC, LOGPIXELSY)
    ReleaseDC 0, hDC

    lParameter = 18 * lDPIY / 96 * 65536 + 120 * lDPIX / 96    'screen coords
    PostMessage hwnd, WM_LBUTTONDOWN, 0&, lParameter    'push button
    PostMessage hwnd, WM_LBUTTONUP, 0&, lParameter    'release button

    If Not bClipboard Then
        Application.CommandBars("Office Clipboard").Visible = False    'hide office clipboard
    End If
    If Not bScreenUpdating Then
        Application.ScreenUpdating = False
    End If

End Sub[/SIZE]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ClearOfficeClipboardResolutionAndLanguageIndependent
End Sub

hwnd = atWindow(iatWindow).Handle: 106

Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long

 Sub ClearOfficeClipBoard()
 Dim Acc As Office.IAccessible
   
   With Application
        .CommandBars("Office Clipboard").Visible = True
   DoEvents
        Set Acc = .CommandBars("Office Clipboard").accChild(1)
        Set Acc = zetAcc(Acc, 3)
        Set Acc = zetAcc(Acc, 0)
        Set Acc = zetAcc(Acc, 3)
        Acc.accDoDefaultAction 2&
        .CommandBars("Office Clipboard").Visible = False
   End With
   
 End Sub
 Private Function zetAcc(myAcc As Office.IAccessible, myChildIndex As Long) As Office.IAccessible
 Dim ReturnAcc As Office.IAccessible
 Dim Count As Long, List() As Variant
 
    Count = myAcc.accChildCount
    ReDim List(Count - 1&)
    If AccessibleChildren(myAcc, 0&, ByVal Count, List(0), Count) = 0& Then Set zetAcc = List(myChildIndex)
 
 End Function