Ribbon Customization: Using a dynamicMenu to Show a List of Open Objects

This is the third post in my short three-part series on ribbon customizations in Access. In the previous post, I showed how you could fill a dropdown with a list of the open forms in the database. This time, we'll fill a dynamicMenu control in a ribbon customization with a list of open objects of any type. This might be useful to let users switch between open objects in an application.

Again, we'll start with the XML for customization:

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="tab1" label="Object Helpers">
                <group id="grp1" label="Helpers">
                    <dynamicMenu id="dynObjectList"
                                 label="Open Objects"
                                 getContent="OnGetObjectList"
                                 invalidateContentOnDrop="true"
                                 size="large"
                                 imageMso="EditListItems"/>
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Add this customization as a record in a USysRibbons table and set the RibbonName property of the database to match the entry in the USysRibbons table.

Before I go into the details of the callbacks, there are a few things you should keep in mind about the dynamicMenu control:

• Content is filled at runtime using the getContent attribute
• The content of the menu is the XML for a customization which contains a menu control as the root control
• The root-level menu in the customization that you create dynamically should include the XML namespace for the Ribbon
• The root-level menu in the customization cannot have an id or a label

The dynamicMenu control also has this pretty cool attribute called invalidateContentOnDrop. When set to true, this causes the control to invalidate which means that the getContent callback is executed for the control. This allows you to show the most recent information in the menu. Given that, let's add the VBA for the callback. Remember that you'll need a reference to the Microsoft Office 12.0 Object Library to compile this code.

' build the list of open objects
Public Sub OnGetObjectList(ctl As IRibbonControl, ByRef content)
    ' add menu
    content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"

    ' tables
    content = content & BuildOpenObjectList(acTable, CurrentData.AllTables)

    ' queries
    content = content & BuildOpenObjectList(acQuery, CurrentData.AllQueries)

    ' forms
    content = content & BuildOpenObjectList(acForm, CurrentProject.AllForms)

    ' reports
    content = content & BuildOpenObjectList(acReport, CurrentProject.AllReports)

    ' macros
    content = content & BuildOpenObjectList(acMacro, CurrentProject.AllMacros)

    ' modules
    content = content & BuildOpenObjectList(acModule, CurrentProject.AllModules)

    ' close the menu
    content = content & "</menu>"
End Sub

You'll notice that this routine calls a helper function called BuildOpenObjectList which is used to create the necessary XML for a menu at runtime. Here's the helper function.

Private Function BuildOpenObjectList(lngType As AcObjectType, col As AllObjects) As String
    Dim strTemp As String
    Dim obj As AccessObject

    ' menu separator node
    strTemp = "<menuSeparator id=""ms|1"" title=""|1""/>"

    ' add the text in the menu separator
    Select Case lngType
        Case AcObjectType.acForm
            strTemp = Replace(strTemp, "|1", "Forms")
        Case AcObjectType.acMacro
            strTemp = Replace(strTemp, "|1", "Macros")
        Case AcObjectType.acModule
            strTemp = Replace(strTemp, "|1", "Modules")
        Case AcObjectType.acQuery
            strTemp = Replace(strTemp, "|1", "Queries")
        Case AcObjectType.acReport
            strTemp = Replace(strTemp, "|1", "Reports")
        Case AcObjectType.acTable
            strTemp = Replace(strTemp, "|1", "Tables")
    End Select

    ' add buttons for the open objects
    For Each obj In col
        If (obj.IsLoaded) Then
            strTemp = strTemp & _
                "<button " & _
                BuildAttribute("id", "btn" & CleanObjectName(obj.Name)) & " " & _
                BuildAttribute("label", obj.Name) & " " & _
                BuildAttribute("tag", obj.Name & "|" & obj.Type) & " " & _
                BuildAttribute("onAction", "OnOpenObject") & "/>"
        End If
    Next

    ' return
    BuildOpenObjectList = strTemp
End Function

Yeah, there's another helper function in there. This one is called BuildAttribute and is used to wrap a string in quotes.

Private Function BuildAttribute(strName As String, strValue As String) As String
    BuildAttribute = strName & "=" & Chr(34) & strValue & Chr(34)
End Function

And, lastly, there's one more helper function to replace some characters that are valid in Access object names but not very XML friendly.

Private Function CleanObjectName(ByVal strName As String) As String
    ' clean the object name so it is more XML-friendly
    Const REPLACE_CHARS As String = " <>\/{}"
    Dim intCounter As Integer

    For intCounter = 1 To Len(REPLACE_CHARS)
        strName = Replace(strName, Mid(REPLACE_CHARS, intCounter, 1), "")
    Next

    ' return
    CleanObjectName = strName
End Function

When you put this all together and open some objects for testing, you should have something that looks like this: