RibbonX-Workshop - Ein beliebiges Tab aktivieren
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.
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
#If Win64 And VBA7 Then
Private Declare PtrSafe Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, _
ByVal cChildren As Long, ByRef rgvarChildren As Variant, _
ByRef pcObtained As LongPtr) As LongPtr
Private Declare PtrSafe Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef psa() As Any) As Long
#Else
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
#End If
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
#If Win64 And VBA7 Then
Dim lngReturn As LongPtr
#Else
Dim lngReturn As Long
#End If
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
Code erfolgreich getestet in Excel 365 64-bit und Excel 365 32-bit