Office 2007 Pro Plus Ribbon Customization Using a

This is the third post in my short three-part series on ribbon customizations in Access. In the previous post,microsoft Office 2010 License, 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="">
<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="""">"
' tables
content = content & BuildOpenObjectList(acTable,Windows 7 Enterprise Key, 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,Office 2007 Pro Plus, 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,Genuine Office 2007, Mid(REPLACE_CHARS, intCounter, 1),Office Pro 2010, "")
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:
<div