RibbonX-Workshop - Ein beliebiges Tab aktivieren

In diesem Beitrag lernen wir, wie wir ein beliebiges Tab im Menüband aktivieren können. Die Beispielcodes beruhen auf Beiträgen von Ribbon-Tab in Excel 2007 ansteuern und Accessing the Ribbon with VBA

Mit dem hier aufgezeigten Code ist es auch möglich, ein beliebiges Tab ohne eigene Ribbon-Definition (Menübandanpassung) anzusteuern. Der Code wurde von mir getestet in den 32-bit-Versionen von Word 2010, Word 2013, Excel 2010 und Excel 2013. Wichtig ist auch hier dass der Code für die 32-bit-Versionen von Microsoft Office geschrieben wurde. Die 64-bit-Versionen finden hier keine Berücksichtigung.

Bisher musste man ein Tab mit dem unzuverlässigen SendKeys (in Office 2007) ansteuern. In Office 2010 und Office 2010 und Office 2013 kann man auch ActivateTab oder ActivateTabMso verwenden. Diese Befehel haben jedoch den Nachteil dass nur Office-Standardtabs und das benutzerdefinierte Tab innerhalb der Datei anzusteuern. Tabs von Fremdtools lassen sich auf "die herkömmliche Weise" nicht ansteuern. In Office 2013 hat man zudem das Problem, dass aufgrund des Fensterhandlings das Ansteuern der Tabs nicht (korrekt) funktioniert. Das Problem lässt sich mit der "Ribbon Accessibility" umgehen.

Kommen wir zuerst zum "Workbook_Open"-Ereignis. Speichern Sie es (wie gewohnt) in "DieseArbeitsmappe" ihrer Datei. Damit sich der Aufbau des Menübandes und das Ansteuern eines Tabs nicht in die Quere kommen (ist z.B. in Excel 2013 der Fall), verzögern wir das Ansteuern eines Tabs mit der OnTime-Methode.

Private Sub Workbook_Open()
    Call Application.OnTime(EarliestTime:=Now, Procedure:="SwitchTabMain")
End Sub


Kommen wir jetzt zu der Prozedur welches das Ansteuern des Tabs anweist. Wichtig ist dass hierbei die Beschriftung des Ribbon-Tabs genutzt wird, nicht dessen ID wie Sie es aus den bisherigen Teilen des Workshops kennen. Dies ist wichtig wenn Sie Ihr Tool für mehrere Sprachversionen entwickeln möchten. Im Beispiel aktivieren wir das Tab "Seitenlayout". Fügen Sie ein neues Modul ein und in dieses den folgenden Code.

Option Private Module
Option Explicit

Public Sub SwitchTabMain()
    If Not SwitchTab("Seitenlayout") Then Call MsgBox("Tab nicht gefunden.", vbCritical, "Fehler")
End Sub


Jetzt kommen wir zum API-Code. Fügen Sie ein neues Modul ein und in dieses den folgenden Code. Diesen Code müssen Sie in der Regel nicht anpassen. Ändern Sie an diesem Code nur etwas wenn Sie wissen was Sie tun oder tun möchten.

Option Private Module
Option Explicit


Private Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, _
                                                              ByVal cChildren As Long, ByRef rgvarChildren As Variant, _
                                                              ByRef pcObtained As Long) As Long
                                                               
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef psa() As Any) As Long

Private Const CHILDID_SELF As Long = &H0&
Private Const STATE_SYSTEM_UNAVAILABLE As Long = &H1&
Private Const STATE_SYSTEM_INVISIBLE As Long = &H8000&
Private Const STATE_SYSTEM_SELECTED As Long = &H2&

Private Enum RoleNumber
    ROLE_SYSTEM_CLIENT = &HA&
    ROLE_SYSTEM_PANE = &H10&
    ROLE_SYSTEM_GROUPING = &H14&
    ROLE_SYSTEM_TOOLBAR = &H16&
    ROLE_SYSTEM_PAGETAB = &H25&
    ROLE_SYSTEM_PROPERTYPAGE = &H26&
    ROLE_SYSTEM_GRAPHIC = &H28&
    ROLE_SYSTEM_STATICTEXT = &H29&
    ROLE_SYSTEM_TEXT = &H2A&
    ROLE_SYSTEM_BUTTONDROPDOWNGRID = &H3A&
    ROLE_SYSTEM_PAGETABLIST = &H3C&
End Enum

Private Enum NavigationDirection
    NAVDIR_FIRSTCHILD = &H7&
End Enum

Public Function SwitchTab(ByVal pvstrTabName As String) As Boolean

Dim objRibbonTab As IAccessible

Set objRibbonTab = GetAccessible(CommandBars("Ribbon"), ROLE_SYSTEM_PAGETAB, pvstrTabName)

    If Not objRibbonTab Is Nothing Then
        If ((objRibbonTab.accState(CHILDID_SELF) And (STATE_SYSTEM_UNAVAILABLE Or STATE_SYSTEM_INVISIBLE)) = 0) Then
            Call objRibbonTab.accDoDefaultAction(CHILDID_SELF)
            SwitchTab = True
        End If
    End If
    
End Function

Private Function GetAccessible(ByRef probjElement As IAccessible, ByVal pvenmRoleWanted As RoleNumber, _
                               ByVal pvstrNameWanted As String, Optional ByVal opvblnGetClient As Boolean) As IAccessible

Dim avntChildrenArray()   As Variant
Dim objChild              As IAccessible
Dim objReturnElement      As IAccessible
Dim ialngChild            As Long
Dim strNameComparand      As String
Dim strName               As String
Dim strValue              As String

    On Error Resume Next

    strValue = probjElement.accValue(CHILDID_SELF)

    On Error GoTo 0

    strName = probjElement.accName(CHILDID_SELF)

    Select Case strValue

        Case "Ribbon", "Quick Access Toolbar", "Ribbon Tabs List", "Lower Ribbon", "Status Bar"
             strNameComparand = strValue
        Case vbNullString, "Ribbon Tab", "Group"
             strNameComparand = strName
        Case Else
             strNameComparand = strName

    End Select

    If probjElement.accRole(CHILDID_SELF) = pvenmRoleWanted And strNameComparand = pvstrNameWanted Then
       Set objReturnElement = probjElement
    Else
       avntChildrenArray = GetChildren(probjElement)
           
           If CBool(SafeArrayGetDim(avntChildrenArray)) Then
              For ialngChild = Lbound(avntChildrenArray) To Ubound(avntChildrenArray)
                  If TypeOf avntChildrenArray(ialngChild) Is IAccessible Then
                     Set objChild = avntChildrenArray(ialngChild)
                     Set objReturnElement = GetAccessible(objChild, pvenmRoleWanted, pvstrNameWanted)
                         If Not objReturnElement Is Nothing Then Exit For
                  End If
              Next
           End If
    End If

    If opvblnGetClient Then Set objReturnElement = objReturnElement.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
    
    Set GetAccessible = objReturnElement
    Set objReturnElement = Nothing
    Set objChild = Nothing

End Function

Private Function GetChildren(ByRef probjElement As IAccessible) As Variant()

Const FIRST_CHILD       As Long = 0&
Dim lngChildCount       As Long
Dim lngReturn           As Long
Dim avntChildrenArray() As Variant

lngChildCount = probjElement.accChildCount

   If lngChildCount > 0 Then
        Redim avntChildrenArray(lngChildCount - 1)
        Call AccessibleChildren(probjElement, FIRST_CHILD, lngChildCount, avntChildrenArray(0), lngReturn)
   End If

GetChildren = avntChildrenArray

End Function