none
Use VBA to Rename a Default Ribbon Tab in Access 2016 RRS feed

  • Question

  • I have a Access 2003 database application with many custom toolbars.  When I open it in Access 2016,  the custom toolbars are shown in the "Add-Ins" ribbon tab.  I'd like to use VBA code or a macro to rename the Add-Ins tab to "PSP Toolbar" automatically when the application is launched.  I've searched the internet but no cigar.  So I'm hoping someone here can help.  Thanks in advance!  Jeff
    Tuesday, November 15, 2016 7:23 PM

All replies

  • Hi Jeff,

    Sorry to say, but I'm not sure it can be done although I won't mind to be proven wrong. I imagine Access internally evaluates if there are any command bars to display and just assigns them to the Add-Ins tab. Not sure where it can be renamed or customized.

    Good luck though...

    Tuesday, November 15, 2016 7:53 PM
  • Hi Jeff,

    I use this code that I get in the web, with some adaptations, to select/change the Tab in a custom Ribbom.

    The Sub I made is selTAB, and i use O2007 and O2010

    Maybe can work for you... with your adaptations.

    Option Compare Database
    Option Explicit
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Definitions and Procedures relating to Accessibility, used by the Ribbon VBA  '
    ' Demonstration UserForm. The constants have been lifted from oleacc.h, and are '
    ' just a subset of those available.                                             '
    '                                                                               '
    '                                                    Tony Jollans, August 2008. '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    Public Const CHILDID_SELF                  As Long = &H0&
    Public Const STATE_SYSTEM_UNAVAILABLE      As Long = &H1&
    Public Const STATE_SYSTEM_INVISIBLE        As Long = &H8000&
    Public Const STATE_SYSTEM_SELECTED         As Long = &H2&
    
    Public 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
    
    Private Declare Function AccessibleChildren _
                    Lib "oleacc.dll" _
                        (ByVal paccContainer As Object, _
                         ByVal iChildStart As Long, _
                         ByVal cChildren As Long, _
                               rgvarChildren As Variant, _
                               pcObtained As Long) _
                    As Long
    
    Public Function GetAccessible _
                        (Element As IAccessible, _
                         RoleWanted As RoleNumber, _
                         NameWanted As String, _
                         Optional GetClient As Boolean) As IAccessible
    
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
        ' This procedure recursively searches the accessibility hierarchy, starting '
        ' with the element given, for an object matching the given name and role.   '
        ' If requested, the Client object, assumed to be the first child, will be   '
        ' returned instead of its parent.                                           '
        '                                                                           '
        ' Called by: RibbonForm procedures to get parent objects as required        '
        '            Itself, recursively, to move down the hierarchy                '
        ' Calls: GetChildren to, well, get children.                                '
        '        Itself, recursively, to move down the hierarchy                    '
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    
        Dim ChildrenArray()
        Dim Child               As IAccessible
        Dim ndxChild            As Long
        Dim ReturnElement       As IAccessible
        
    2:    If Element.accRole(CHILDID_SELF) = RoleWanted _
        And Element.accName(CHILDID_SELF) = NameWanted Then
    
    3:        Set ReturnElement = Element
            
    4:    Else ' not found yet
        
    5:        ChildrenArray = GetChildren(Element)
            
    6:        If (Not ChildrenArray) <> True Then
                
    7:            For ndxChild = LBound(ChildrenArray) To UBound(ChildrenArray)
                    
    8:                If TypeOf ChildrenArray(ndxChild) Is IAccessible Then
                    
    9:                    Set Child = ChildrenArray(ndxChild)
    10:                    Set ReturnElement = GetAccessible(Child, _
                                                          RoleWanted, _
                                                          NameWanted)
    11:                    If Not ReturnElement Is Nothing Then Exit For
                    
    12:                End If ' Child is IAccessible
                
    13:            Next ndxChild
            
    14:        End If ' there are children
        
    15:    End If ' still looking
    
    16:    If GetClient Then
    17:        Set ReturnElement = ReturnElement.accNavigate(NAVDIR_FIRSTCHILD, _
                                                          CHILDID_SELF)
    18:    End If
        
    19:    Set GetAccessible = ReturnElement
        
    End Function
    
    Public Function GetChildren(Element As IAccessible) As Variant()
    
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
        ' General purpose subroutine to get an array of children of an IAccessible  '
        ' object. The returned array is Variant because the elements may be either  '
        ' IAccessible objects or simple (Long) elements, and the caller must treat  '
        ' them appropriately.                                                       '
        '                                                                           '
        ' Called by: GetAccessible when searching for an Accessible element         '
        ' Calls: AccessibleChildren API                                             '
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    2:    Const FirstChild        As Long = 0&
        Dim NumChildren         As Long
        Dim NumReturned         As Long
        Dim ChildrenArray()
    3:    NumChildren = Element.accChildCount
    4:    If NumChildren > 0 Then
    5:        ReDim ChildrenArray(NumChildren - 1)
    6:        AccessibleChildren Element, FirstChild, NumChildren, _
                               ChildrenArray(0), NumReturned
    7:    End If
    8:    GetChildren = ChildrenArray
        
    End Function
    
    Public Sub SwitchTab(TabName As String)
    
        Dim RibbonTab   As IAccessible
    
    2:    Set RibbonTab = GetAccessible(CommandBars("Ribbon"), _
                                      ROLE_SYSTEM_PAGETAB, _
                                      TabName)
    
    3:    If Not RibbonTab Is Nothing Then
    4:        If ((RibbonTab.accState(CHILDID_SELF) _
                    And (STATE_SYSTEM_UNAVAILABLE Or _
                         STATE_SYSTEM_INVISIBLE)) = 0) Then
    5:            RibbonTab.accDoDefaultAction CHILDID_SELF
    6:        End If
    7:    End If
    
    End Sub
    
    Public Sub selTAB(ktrl As IRibbonControl, ByRef retVal)
     Dim STT As String
    2: retVal = True
    3: STT = Application.CurrentDb.Properties("ribbonTAB").Value
    4: If STT <> " " Then
    5:  SwitchTab (STT)
    6:  ChangeProperty "ribbonTAB", dbText, " "
    7: End If
    End Sub
    
    Option Compare Database
    Option Explicit
    
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    ' Definitions and Procedures relating to Accessibility, used by the Ribbon VBA  '
    ' Demonstration UserForm. The constants have been lifted from oleacc.h, and are '
    ' just a subset of those available.                                             '
    '                                                                               '
    '                                                    Tony Jollans, August 2008. '
    ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    
    Public Const CHILDID_SELF                  As Long = &H0&
    Public Const STATE_SYSTEM_UNAVAILABLE      As Long = &H1&
    Public Const STATE_SYSTEM_INVISIBLE        As Long = &H8000&
    Public Const STATE_SYSTEM_SELECTED         As Long = &H2&
    
    Public 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
    
    Private Declare Function AccessibleChildren _
                    Lib "oleacc.dll" _
                        (ByVal paccContainer As Object, _
                         ByVal iChildStart As Long, _
                         ByVal cChildren As Long, _
                               rgvarChildren As Variant, _
                               pcObtained As Long) _
                    As Long
    
    Public Function GetAccessible _
                        (Element As IAccessible, _
                         RoleWanted As RoleNumber, _
                         NameWanted As String, _
                         Optional GetClient As Boolean) As IAccessible
    
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
        ' This procedure recursively searches the accessibility hierarchy, starting '
        ' with the element given, for an object matching the given name and role.   '
        ' If requested, the Client object, assumed to be the first child, will be   '
        ' returned instead of its parent.                                           '
        '                                                                           '
        ' Called by: RibbonForm procedures to get parent objects as required        '
        '            Itself, recursively, to move down the hierarchy                '
        ' Calls: GetChildren to, well, get children.                                '
        '        Itself, recursively, to move down the hierarchy                    '
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    
        Dim ChildrenArray()
        Dim Child               As IAccessible
        Dim ndxChild            As Long
        Dim ReturnElement       As IAccessible
        
    2:    If Element.accRole(CHILDID_SELF) = RoleWanted _
        And Element.accName(CHILDID_SELF) = NameWanted Then
    
    3:        Set ReturnElement = Element
            
    4:    Else ' not found yet
        
    5:        ChildrenArray = GetChildren(Element)
            
    6:        If (Not ChildrenArray) <> True Then
                
    7:            For ndxChild = LBound(ChildrenArray) To UBound(ChildrenArray)
                    
    8:                If TypeOf ChildrenArray(ndxChild) Is IAccessible Then
                    
    9:                    Set Child = ChildrenArray(ndxChild)
    10:                    Set ReturnElement = GetAccessible(Child, _
                                                          RoleWanted, _
                                                          NameWanted)
    11:                    If Not ReturnElement Is Nothing Then Exit For
                    
    12:                End If ' Child is IAccessible
                
    13:            Next ndxChild
            
    14:        End If ' there are children
        
    15:    End If ' still looking
    
    16:    If GetClient Then
    17:        Set ReturnElement = ReturnElement.accNavigate(NAVDIR_FIRSTCHILD, _
                                                          CHILDID_SELF)
    18:    End If
        
    19:    Set GetAccessible = ReturnElement
        
    End Function
    
    Public Function GetChildren(Element As IAccessible) As Variant()
    
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
        ' General purpose subroutine to get an array of children of an IAccessible  '
        ' object. The returned array is Variant because the elements may be either  '
        ' IAccessible objects or simple (Long) elements, and the caller must treat  '
        ' them appropriately.                                                       '
        '                                                                           '
        ' Called by: GetAccessible when searching for an Accessible element         '
        ' Calls: AccessibleChildren API                                             '
        ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
    2:    Const FirstChild        As Long = 0&
        Dim NumChildren         As Long
        Dim NumReturned         As Long
        Dim ChildrenArray()
    3:    NumChildren = Element.accChildCount
    4:    If NumChildren > 0 Then
    5:        ReDim ChildrenArray(NumChildren - 1)
    6:        AccessibleChildren Element, FirstChild, NumChildren, _
                               ChildrenArray(0), NumReturned
    7:    End If
    8:    GetChildren = ChildrenArray
        
    End Function
    
    Public Sub SwitchTab(TabName As String)
    
        Dim RibbonTab   As IAccessible
    
    2:    Set RibbonTab = GetAccessible(CommandBars("Ribbon"), _
                                      ROLE_SYSTEM_PAGETAB, _
                                      TabName)
    
    3:    If Not RibbonTab Is Nothing Then
    4:        If ((RibbonTab.accState(CHILDID_SELF) _
                    And (STATE_SYSTEM_UNAVAILABLE Or _
                         STATE_SYSTEM_INVISIBLE)) = 0) Then
    5:            RibbonTab.accDoDefaultAction CHILDID_SELF
    6:        End If
    7:    End If
    
    End Sub
    
    Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
        Dim dbs As Object, prp As Variant
    2:    Const conPropNotFoundError = 3270
    3:    Set dbs = CurrentDb
    4:    On Error GoTo Change_Err
    5:    dbs.Properties(strPropName) = varPropValue
    6:    ChangeProperty = True
    Change_Bye:
    7:    Set dbs = Nothing
    8:    Exit Function
    Change_Err:
    9:    If Err = conPropNotFoundError Then    ' Property not found.
    10:        Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
    11:        dbs.Properties.Append prp
    12:        Resume Next
    13:    Else
            ' Unknown error.
    14:        ChangeProperty = False
    15:        Resume Change_Bye
    16:    End If
    End Function
    
    Public Sub selTAB(ktrl As IRibbonControl, ByRef retVal)
     Dim STT As String
    2: retVal = True
    3: STT = Application.CurrentDb.Properties("ribbonTAB").Value ' the name of the TAB
    4: If STT <> " " Then
    5:  SwitchTab (STT)
    6:  ChangeProperty "ribbonTAB", dbText, " "
    7: End If
    End Sub
    
    

    HTH


    Joao Simplicio Rodrigues

    Wednesday, November 16, 2016 3:43 PM
  • Hi,

    We could rename the built-in tab.

    I would suggest you visit Customize the Ribbon

    Use XML like:

    <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
      <ribbon>
        <tabs>
          <tab idMso="TabAddIns" label="NewTabName">
            <group id="group1" label="Group1">
              <button id="testBtn" label="testBtn"/>
            </group>
          </tab>
        </tabs>
      </ribbon>
    </customUI>

    The link above shows how to apply the custom ribbon manually.

    If you want to use VBA, we could use Application.LoadCustomUI Method (Access), but we also need to manually chose the ribbon in Access Options. We are unable to set it by VBA, please see

    Set Options from Visual Basic, Office does not provide the option "Ribbon and Toolbar Options" in VBA.

    Create an AutoExec macro to load the customUI. See Automate startup events with a macro

    Then in the Options -> Current Database -> Ribbon and Toolbar Options ->select the Ribbon Name list, and then click the Ribbon that you want. (Same as the steps in Customize the Ribbon )

    Use VBA:

    Create a Function below and then create an AutoExec macro to call the function. Reopen the Access let the cutomUIXML show in the Access Option, close and open again, you could see the custom ribbon then.

    Function customRibbon()
     Dim customerXML As String
    customXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">" _
                & "  <ribbon>" _
                & "    <tabs>" _
                & "      <tab idMso=""TabAddIns"" label=""NewTabName"">" _
                & "        <group id=""group1"" label=""Group1"">" _
                & "          <button id=""testBtn"" label=""testBtn""/>" _
                & "        </group>" _
                & "      </tab>" _
                & "    </tabs>" _
                & "  </ribbon>" _
                & "</customUI>"
    Application.LoadCustomUI "test", customXML
    End Function
    

    Regards,

    Celeste




    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, November 17, 2016 6:24 AM
    Moderator
  • Hi,

    I was going this thread and I felt that for Automating few Tasks for Office Apps,I would require few more Roles like 


    ROLE_SYSTEM_CHARACTER
    ROLE_SYSTEM_CHART
    ROLE_SYSTEM_CHECKBUTTON
    ROLE_SYSTEM_CLIENT

    ROLE_SYSTEM_CLOCK

    But I am not able to find the Corresponding Enum Values..Could any one please point me to some link where values in HEX(i.e.ROLE_SYSTEM_CLIENT = &HA)have been mentioned so that I can use it accordingly.

    Thanks


    Point5Nyble

    Friday, July 21, 2017 5:59 AM