Maybe this would do the job for you.
You will need to add two buttons of your own.
One to call sub ListMenuInforRevised and
one to call sub RemoveSpecialToolbar.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
'Adds a new toolbar and then adds all custom menu items from _
'visible menubars and toolbars plus shortcut menus to it.
'March 03, 2004 - James Cone, San Francisco, USA
'March 05, 2006 - Added toolbars and shortcuts.
'There is no error handling code.
'========================
'Calls ListMore function.
Sub ListMenuInfoRevised()
'James Cone - San Francisco, USA - March 2004 & March 2006
Dim cmdBar As CommandBar
Dim cmdSpecialBar As CommandBar
Dim objMenuItem As CommandBarControl
Dim objMenu As CommandBarControl
Dim cmdMenus As CommandBarControl
Dim cmdToolbars As CommandBarControl
Dim cmdShortcuts As CommandBarControl
Dim colItems As VBA.Collection
Dim strTag As String
Dim lngNum As Long
RemoveSpecialToolbar
Set colItems = New Collection
'New Command bar
Set cmdSpecialBar = Application.CommandBars.Add(Name:="Custom List", Position:=msoBarTop)
With Application.CommandBars("Formatting")
cmdSpecialBar.Left = .Width
cmdSpecialBar.RowIndex = .RowIndex
End With
'Three new controls on the new command bar.
Set cmdMenus = cmdSpecialBar.Controls.Add(Type:=msoControlPopup)
cmdMenus.Caption = "Menu Bar"
Set cmdToolbars = cmdSpecialBar.Controls.Add(Type:=msoControlPopup)
cmdToolbars.Caption = "Toolbars"
Set cmdShortcuts = cmdSpecialBar.Controls.Add(Type:=msoControlPopup)
cmdShortcuts.Caption = "Shortcuts"
For Each cmdBar In Application.CommandBars
If (cmdBar.Visible And cmdBar.Name <> "Custom List") Then
'File, Edit, View, Insert etc.
For Each objMenu In cmdBar.Controls
If cmdBar.Type = msoBarTypeMenuBar Then 'Worksheet & Chart menu bars
strTag = "1"
If objMenu.ID = 1 Or Not objMenu.BuiltIn Then
objMenu.Copy bar:=cmdMenus.CommandBar
GoTo Exit_Loop
End If
Else 'Toolbars
'Custom controls only, no modified BuiltIn controls.
strTag = "2"
If objMenu.ID = 1 Then
objMenu.Copy bar:=cmdToolbars.CommandBar
GoTo Exit_Loop
End If
End If
'Determine if a objMenu is a control or a button.
On Error Resume Next
lngNum = objMenu.Controls.Count
If Err.Number = 0 Then 'Control
On Error GoTo 0
Call ListMore(objMenu.Controls, colItems, strTag)
Else 'Button
On Error GoTo 0
If objMenu.ID = 1 Or Not objMenu.BuiltIn Then
objMenu.Tag = strTag
On Error Resume Next
colItems.Add objMenu, objMenu.Caption
On Error GoTo 0
End If
End If 'Err.Number = 0
Exit_Loop:
Next 'objMenu
ElseIf cmdBar.Type = msoBarTypePopup Then
strTag = "3"
For Each objMenu In cmdBar.Controls
If objMenu.ID = 1 Or Not objMenu.BuiltIn Then
objMenu.Tag = strTag
On Error Resume Next
colItems.Add objMenu, objMenu.Caption
On Error GoTo 0
End If
Next
End If
Next 'CmdBar
If colItems.Count > 0 Then
'Add each control from the collection to the appropriate control.
'Controls can only be copied to CommandBars.
For Each objMenuItem In colItems
Select Case objMenuItem.Tag
Case "1"
objMenuItem.Copy cmdMenus.CommandBar
Case "2"
objMenuItem.Copy cmdToolbars.CommandBar
Case "3"
objMenuItem.Copy cmdShortcuts.CommandBar
End Select
Next
'Disable each control that has no menu items.
cmdMenus.Enabled = (cmdMenus.Controls.Count > 0)
cmdToolbars.Enabled = (cmdToolbars.Controls.Count > 0)
cmdShortcuts.Enabled = (cmdShortcuts.Controls.Count > 0)
cmdSpecialBar.Visible = True
Else
RemoveSpecialToolbar
MsgBox "No custom menus or buttons found. ", vbInformation, " List Custom Stuff"
End If
Set cmdBar = Nothing
Set objMenu = Nothing
Set colItems = Nothing
Set cmdMenus = Nothing
Set cmdToolbars = Nothing
Set objMenuItem = Nothing
Set cmdShortcuts = Nothing
Set cmdSpecialBar = Nothing
End Sub
'======================
'Called by ListMenuInfoRevised and by itself (Recursive).
Function ListMore(objControls As CommandBarControls, ByRef colObject As VBA.Collection, _
ByRef strSuffix As String)
Dim objItem As CommandBarControl
For Each objItem In objControls
If objItem.ID = 1 Or Not objItem.BuiltIn Then
objItem.Tag = strSuffix
On Error Resume Next
colObject.Add objItem, objItem.Caption
Err.Clear
On Error GoTo 0
Else
On Error Resume Next
If objItem.Controls.Count > 0 Then
If Err.Number = 0 Then
On Error GoTo 0
Call ListMore(objItem.Controls, colObject, strSuffix)
Else
Err.Clear
On Error GoTo 0
End If
End If
End If
Next
End Function
'======================
Sub RemoveSpecialToolbar()
On Error Resume Next
Application.CommandBars("Custom List").Delete
End Sub
'----------------------------------------------------------------------------------------------------
"A Pragmatic Cynic"
<
[email protected]>
wrote in message
Hi,
I have downloaded numerous utilities created by the MVPs. (Thank to all of
you, they are excellent tools.) Anyway, several of them create new menus on
the menu bar. Is there a way to have consolidate things into one menu? I
have tried the customization process used with toolbars, but every time I
exit and return they have moved back to separate menus.
