Office 2016 - Clipboard

using Office=Microsoft.Office.Core;
Office.CommandBars cmdBars = ExcelApp.CommandBars;
Office.CommandBar cmdBar = cmdBars["Office Clipboard"];
cmdBar.Visible = true;
Marshal.ReleaseComObject(cmdBar); cmdBar = null;
Marshal.ReleaseComObject(cmdBars); cmdBars = null;

Option Explicit


' *** DEKLARATIONEN ***
'
Const CHILDID_SELF = 0&
Const ROLE_PUSHBUTTON = &H2B&
Const WM_GETTEXT = &HD
'
Type tGUID
  lData1 As Long
  nData2 As Integer
  nData3 As Integer
  abytData4(0 To 7) As Byte
End Type
'
Type AccObject
  objIA As IAccessible
  lngChild As Long
End Type
'
Dim lngChild As Long                  'Handle als R?ckgabe
Dim strClass As String                'gesuchte Klasse, z.B. Commandbar
Dim strCaption As String              'Titel eines Fensters
Dim strCommandbarName As String       'lokalisierter Name der gesuchten Commandbar
Dim strTaskpaneName As String         'lokalisierter Name der gesuchten Taskpane
Dim strButtonName As String           'lokalisierter Name des gesuchten Schalters

'
Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, riid As tGUID, ppvObject As Object) As Long
Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, rgvarChildren As Variant, pcObtained As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long


' *** AUFRUF der Prozedur ***

' * leert die Office-Zwischenablage
Sub ClearOfficeClipboard()
  'HINWEIS: dieses Tool ist nut mit Excel getestet
  Dim blnScreenUpdating As Boolean      'Voreinstellung der Aktualisierung merken
  Dim intOffLanguage As Integer         'eingestellte Office-Sprache
  Dim blnTaskPaneVis As Boolean         'Voreinstellung der Commandbar merken
  Dim lngTaskPaneHwnd As Long           'Handle der gesuchten Commandbar
  Dim oButton As AccObject
  
  'Aktualisierung der Ansicht erzwingen
  blnScreenUpdating = Application.ScreenUpdating
  Application.ScreenUpdating = True
  
  'eingestellte Sprache abfragen
  Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
    Case 1031     'deutsch
      strCommandbarName = "Office Clipboard"
      strTaskpaneName = "Office-Zwischenablage"
      strButtonName = "Alle l?schen"
    Case 1033     'englisch
      strCommandbarName = "Office Clipboard"
      strTaskpaneName = "Office Clipboard"
      strButtonName = "Clear All"
    Case Else     'nicht unterst?tzt
      MsgBox "Die eingestellte Sprache wird nicht untersch?tzt!"
      GoTo EndSub
  End Select
  
  'Sichtbarkeit der Commandbar merken und einstellen
  blnTaskPaneVis = Application.CommandBars(strCommandbarName).Visible
  If blnTaskPaneVis = False Then
    Application.CommandBars(strCommandbarName).Visible = True
    'Zeit zur Initalisierung und dem Aufbau schinden
    ' ohne diese Verz?gerung wird der Schalter nicht gefunden, falls das Clipboard ausgeblendet war
    Application.Wait (Now + TimeValue("0:00:01"))
  End If
  'ActiveSheet.Select
  
  'Handle der Clipboard-Commandbar ermitteln
  lngTaskPaneHwnd = GetOfficeTaskPaneHwnd(Excel.Application)
  
  'Schalter 'Clear All' in der Clipboard-Commandbar ermitteln
  oButton = FindAccessibleChildInWindow(lngTaskPaneHwnd, strButtonName, ROLE_PUSHBUTTON)
  If oButton.objIA Is Nothing Then
    'Fehlerabfang, wenn nichts gefunden wurde
    MsgBox "Schalter '" & strButtonName & "' nicht gefunden!"
  Else
    'Schalter ausf?hren
    oButton.objIA.accDoDefaultAction oButton.lngChild
  End If

  'Sichtbarkeit der Commandbar zur?cksetzen
  Application.CommandBars(strCommandbarName).Visible = blnTaskPaneVis

EndSub:
  'Aktualisierung der Ansicht zur?cksetzen
  Application.ScreenUpdating = blnScreenUpdating
  
End Sub


' *** HILFSFUNKTIONEN ***
'
'Retrieve window class name
Function GetWndClass(ByVal hWnd As Long) As String
  Dim buf As String, retval As Long
  buf = Space(256)
  retval = GetClassName(hWnd, buf, 255)
  GetWndClass = Left(buf, retval)
End Function
'
'Retrieve window title
Function GetWndText(ByVal hWnd As Long) As String
  Dim buf As String, retval As Long
  buf = Space(256)
  retval = SendMessage(hWnd, WM_GETTEXT, 255, buf)
  GetWndText = Left(buf, InStr(1, buf, Chr(0)) - 1)
End Function
'
'The call back function used by EnumChildWindows
Function EnumChildWndProc(ByVal hChild As Long, ByVal lParam As Long) As Long
  Dim found As Boolean
  EnumChildWndProc = -1
  If strClass > "" And strCaption > "" Then
  Debug.Print GetWndClass(hChild) & "; " & GetWndText(hChild)
    found = StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0 And _
    StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0
  ElseIf strClass > "" Then
    found = (StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0)
  ElseIf strCaption > "" Then
    found = (StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0)
  Else
    found = True
  End If

  If found Then
    lngChild = hChild
    EnumChildWndProc = 0
  Else
    EnumChildWndProc = -1
  End If
End Function
'
'Find the window handle of a child window based on its class and titie
Function FindChildWindow(ByVal hParent As Long, Optional cls As String = "", Optional title As String = "") As Long
  lngChild = 0
  strClass = cls
  strCaption = title
  EnumChildWindows hParent, AddressOf EnumChildWndProc, 0
  FindChildWindow = lngChild
End Function
'
'Retrieve the IAccessible interface from a window handle
'Reference:Jean Ross,Chapter 17: Accessibility in Visual Basic,Advanced Microsoft Visual Basic 6.0, 2nd Edition
Function IAccessibleFromHwnd(hWnd As Long) As IAccessible
  Dim oIA As IAccessible
  Dim tg As tGUID
  Dim lReturn As Long
  
  'Define the GUID for the IAccessible object {618736E0-3C3D-11CF-810C-00AA00389B71}
  With tg
    .lData1 = &H618736E0
    .nData2 = &H3C3D
    .nData3 = &H11CF
    .abytData4(0) = &H81
    .abytData4(1) = &HC
    .abytData4(2) = &H0
    .abytData4(3) = &HAA
    .abytData4(4) = &H0
    .abytData4(5) = &H38
    .abytData4(6) = &H9B
    .abytData4(7) = &H71
  End With
  
  'Retrieve the IAccessible object for the form
  lReturn = AccessibleObjectFromWindow(hWnd, 0, tg, oIA)
  Set IAccessibleFromHwnd = oIA
End Function
'
'Recursively looking for a child with specified accName and accRole in the accessibility tree
Function FindAccessibleChild(oParent As IAccessible, strName As String, lngRole As Long) As AccObject
  Dim lHowMany As Long
  Dim avKids() As Variant
  Dim lGotHowMany As Long, i As Integer
  Dim oChild As IAccessible
  
  FindAccessibleChild.lngChild = CHILDID_SELF
  If oParent.accChildCount = 0 Then
    Set FindAccessibleChild.objIA = Nothing
    Exit Function
  End If
  lHowMany = oParent.accChildCount
  ReDim avKids(lHowMany - 1) As Variant
  lGotHowMany = 0
  If AccessibleChildren(oParent, 0, lHowMany, avKids(0), lGotHowMany) <> 0 Then
    MsgBox "Error retrieving accessible children!"
    Set FindAccessibleChild.objIA = Nothing
    Exit Function
  End If
  
  'To do: the approach described in http://msdn.microsoft.com/msdnmag/issues/0400/aaccess/default.aspx are probably better and more reliable
  On Error Resume Next
  For i = 0 To lGotHowMany - 1
    If IsObject(avKids(i)) Then
      If StrComp(avKids(i).accName, strName) = 0 And avKids(i).accRole = lngRole Then
        Set FindAccessibleChild.objIA = avKids(i)
        Exit For
      Else
        Set oChild = avKids(i)
        FindAccessibleChild = FindAccessibleChild(oChild, strName, lngRole)
        If Not FindAccessibleChild.objIA Is Nothing Then
          Exit For
        End If
      End If
    Else
      If StrComp(oParent.accName(avKids(i)), strName) = 0 And oParent.accRole(avKids(i)) = lngRole Then
        Set FindAccessibleChild.objIA = oParent
        FindAccessibleChild.lngChild = avKids(i)
        Exit For
      End If
    End If
  Next i
End Function
'
Function FindAccessibleChildInWindow(hwndParent As Long, strName As String, lngRole As Long) As AccObject
  Dim oParent As IAccessible
  
  Set oParent = IAccessibleFromHwnd(hwndParent)
  If oParent Is Nothing Then
    Set FindAccessibleChildInWindow.objIA = Nothing
  Else
    FindAccessibleChildInWindow = FindAccessibleChild(oParent, strName, lngRole)
  End If
End Function
'
'Generic routine to retrieve the window handle of the active window of an Office Application
Function GetOfficeAppHwnd(app As Object) As Long
  GetOfficeAppHwnd = FindWindow(vbNullString, GetOfficeAppWindowTitle(app))
End Function
'
'Retrieve the window handle of the task pane
'Notice: the task pane window title is localized!
Function GetOfficeTaskPaneHwnd(app As Object) As Long
  GetOfficeTaskPaneHwnd = FindChildWindow(GetOfficeAppHwnd(app), "MsoCommandBar", strTaskpaneName)
End Function
'
'Generic routine to retrieve the window title of the active window of an Office application
Function GetOfficeAppWindowTitle(app As Object) As String
  On Error GoTo ErrorHandler
  Select Case app.Name
    Case "Microsoft Word"
      GetOfficeAppWindowTitle = app.ActiveWindow.Caption & " - " & "Word"
    Case "Microsoft Excel"
      GetOfficeAppWindowTitle = app.ActiveWindow.Caption & " - " & "Excel"
  End Select
Exit Function

ErrorHandler:
  MsgBox "Unsupported Office application!"
  GetOfficeAppWindowTitle = ""
End Function