Activate Ribbon-Tab Without XML or API calls

[Jaafar Tribak]

Hi dear members,

I just thought I would share with you here this very small and simple vba function that I recently wrote for switching ribbon tabs.

Option Explicit

Function ActivateRibbonTab(ByVal TabName As String) As Boolean

    Const CHILDID_SELF = 0&, NAVDIR_FIRSTCHILD = 7&, NAVDIR_NEXT = 5&
    Dim accObj As IAccessible, i As Long, lTabsCount As Long
     
    Set accObj = Application.CommandBars("Ribbon")
    For i = 1 To 7
        Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
    Next i
    For i = 1 To 6
        Set accObj = accObj.accNavigate(NAVDIR_NEXT, CHILDID_SELF)
    Next i
    Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
    lTabsCount = accObj.accChildCount
    Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
    On Error Resume Next
    For i = 1 To lTabsCount
        Set accObj = accObj.accNavigate(NAVDIR_NEXT, CHILDID_SELF) '!!!!
        If UCase(accObj.accName(CHILDID_SELF)) = UCase(TabName) Then
            accObj.accDoDefaultAction CHILDID_SELF
            ActivateRibbonTab = Not CBool(Err.Number)
            Exit Function
        End If
    Next i
End Function

Function Usage example:
The following test routine should activate te "Data" tab :

Sub Test()
    If ActivateRibbonTab(TabName:="Data") Then
        MsgBox "Ribbon-Tab activated successfully !"
    Else
        MsgBox "Ribbon-Tab not found !"
    End If
End Sub

 

[leonlai]

Hi, Jaafar

I was looking for something like your post. I have not found a similar post elsewhere.

I want to activate any chosen tab in Excel (e.g. Data Tab), and I think your code could solve my problem.

But when I ran your code, it blocks at this line:

  Next i
    Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)    <----

Any idea what could have gone wrong? I use Excel 2016


-----
What I did:

I simply copied your codes in a VBA Module.

Then I dragged a rectangle shape on my Excel Sheet.

Then assigned the macro "Test" . I use Excel 2016.

Thanks
Leon

 

[sadboy309]

I search on Google and I found a link interesting, I share it here:
http://www.wordarticles.com/Shorts/RibbonVBA/RibbonVBADemo.php

 

[leonlai]

Hi, sadboy309

Thanks for sharing.
Good week-end
Leon

 

[Jaafar Tribak]

@leonlai

Better late than never.

For excel 2016

Private Function ActivateRibbonTab(ByVal TabName As String) As Boolean

    Const CHILDID_SELF = 0&, NAVDIR_FIRSTCHILD = 7&
    Const NAVDIR_LASTCHILD = 8&, NAVDIR_NEXT = 5&
    Dim accObj As IAccessible, i As Long, j As Long, lChildCount As Long
    
    
    Set accObj = Application.CommandBars("Ribbon")
    
    Set accObj = accObj.accNavigate(NAVDIR_LASTCHILD, CHILDID_SELF)
    Set accObj = accObj.accNavigate(NAVDIR_LASTCHILD, CHILDID_SELF)
    Set accObj = accObj.accNavigate(NAVDIR_LASTCHILD, CHILDID_SELF)
    Set accObj = accObj.accNavigate(NAVDIR_LASTCHILD, CHILDID_SELF)
    Set accObj = accObj.accNavigate(NAVDIR_LASTCHILD, CHILDID_SELF)
    Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
    lChildCount = accObj.accChildCount
    Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
    
    On Error Resume Next
    For i = 1 To lChildCount
        Set accObj = accObj.accNavigate(NAVDIR_NEXT, CHILDID_SELF)
        If UCase(accObj.accName(CHILDID_SELF)) = UCase("Ribbon Tabs") Then
            Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
            lChildCount = accObj.accChildCount
            Set accObj = accObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
            For j = 1 To lChildCount
                Set accObj = accObj.accNavigate(NAVDIR_NEXT, CHILDID_SELF)
                If UCase(accObj.accName(CHILDID_SELF)) = UCase(TabName) Then
                    accObj.accDoDefaultAction CHILDID_SELF
                    ActivateRibbonTab = Not CBool(Err.Number)
                    Exit Function
                End If
            Next j
        End If
    Next i


End Function

Code Usage:

Sub Test()
    If ActivateRibbonTab(TabName:="Data") Then
        MsgBox "Ribbon-Tab activated successfully !"
    Else
        MsgBox "Ribbon-Tab not found !"
    End If
End Sub

 

[leonlai]

Hi, Jaafar,
Yes, better late than never.
Thanks for your nice thoughts.

Leon