Menu Bar Maker

This demonstrates how to create a menu bar and use it in place of the "Worksheet Menu Bar" The current state of the "Worksheet Menu Bar" is retained, so you don't lose any customisation to the menus when you restore it.

Here is a link to the demonstration file which contains all the code described on this page: MenuBarMaker

The code is in two modules:

MenuBarMaker
Utilities

MenuBarMaker Code

This consists of one routine. The in-line comments describe the action.

Option Explicit

Public Const cstr_Wmb = "Worksheet Menu Bar"
Public Const cstr_MbTester = "Tester"

'' ***************************************************************************
'' Purpose  : Creates a menubar
'' Written  : 05-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Sub CreateMenuBar()
Dim x$

    ''If our target menubar exists, delete it
    DeleteCommandBar cstr_MbTester

    ''Now add a new Command Bar
    ''The argument, "MenuBar:=True", replaces the active menu bar, but does not delete it
    Application.CommandBars.Add Name:=cstr_MbTester, MenuBar:=True
    
    '' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
    '' The code between here and the next set of " # # # " generates the menus
    '' and sub menus. You can use it as a template for your own requirements.
    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ''Create a menu control called "One" and populate it
    x = "&One"
    CommandBars(cstr_MbTester).Controls.Add(msoControlPopup).Caption = x
    
    ''Use the menu to create the menu item(s)
    With CommandBars(cstr_MbTester).Controls(x)
       
        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &1"
        .Controls.Add(Type:=msoControlButton).Caption = x
        .Controls(x).OnAction = "'MsgBox """ & x & """'"

        '' This structure ..
        ''  "'MsgBox """ & x & """'"
        '' .. runs Msgbox which shows the menu argument.
        ''To run a macro without arguments, enclose its name in quotes, e.g.,
        ''          .Controls(x).OnAction = "Macroname"
        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &2"
        .Controls.Add(Type:=msoControlButton).Caption = x
        With .Controls(x)
            .OnAction = "'MsgBox """ & x & """'"
            .State = msoButtonDown
            ''Item appears greyed out
            .Enabled = False
            ''Add a separator bar before the menu item
            .BeginGroup = True
        End With

        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "&Edit Box"
        With .Controls.Add(Type:=msoControlEdit)
            .Caption = x
        End With

        With .Controls(x)
            .Tag = "TestEditBox"
            .Text = "222"
            .OnAction = "ReturnTestEditBoxValue"
        End With

        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        ''## Adding a sub menu with three items
        Dim z$
        z = "Sub&Menu"
        .Controls.Add(Type:=msoControlPopup).Caption = z

        With .Controls(z)
            x = "Sub Item &1"
            .Controls.Add(Type:=msoControlButton).Caption = x
            .Controls(x).OnAction = "'MsgBox """ & x & """'"

            x = "Sub Item &2"
            .Controls.Add(Type:=msoControlButton).Caption = x
            .Controls(x).OnAction = "'MsgBox """ & x & """'"
            
            x = "Sub Item &3"
            .Controls.Add(Type:=msoControlButton).Caption = x
            .Controls(x).OnAction = "'MsgBox """ & x & """'"
        End With
        ''##

        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &3"
        .Controls.Add(Type:=msoControlButton).Caption = x
        .Controls(x).OnAction = "'MsgBox """ & x & """'"

        ''This deletes the above addition, so it will never appear on the menu
        .Controls(x).Delete

        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &4"
        .Controls.Add(Type:=msoControlButton).Caption = x
        With .Controls(x)
            .OnAction = "'MsgBox """ & x & """'"
            .State = msoButtonDown
            .BeginGroup = True
        End With

    End With

    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ''Create a menu control called "Two" and populate it
    x = "&Two"
    CommandBars(cstr_MbTester).Controls.Add(msoControlPopup).Caption = x
    
    ''Use the menu to create the menu item(s)
    With CommandBars(cstr_MbTester).Controls(x)
       
        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &1"
        .Controls.Add(Type:=msoControlButton).Caption = x
        .Controls(x).OnAction = "'MsgBox """ & x & """'"
        
        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &2"
        .Controls.Add(Type:=msoControlButton).Caption = x
        With .Controls(x)
            .OnAction = "'MsgBox """ & x & """'"
            ''Add a separator bar before the menu item
            .BeginGroup = True
        End With

        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &3"
        .Controls.Add(Type:=msoControlButton).Caption = x
        .Controls(x).OnAction = "'MsgBox """ & x & """'"

        '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        x = "Menu Item &4"
        .Controls.Add(Type:=msoControlButton).Caption = x
        With .Controls(x)
            .OnAction = "'MsgBox """ & x & """'"
            .BeginGroup = True
        End With

    End With
    
    '' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ''Finally, we want to see it so make it visible
    CommandBars(cstr_MbTester).Visible = True

End Sub

Utilities Code

Here are the routines that support the one above. Again, the in-line comments describe the action

Option Explicit

'' ***************************************************************************
'' Purpose  : Get the active menubar's name
'' Written  : 05-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Sub ActiveMenuBarName()
    MsgBox CommandBars.ActiveMenuBar.Name
End Sub

'' ***************************************************************************
'' Purpose  : Restore the "Worksheet Menu Bar"
'' Written  : 05-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Sub wmb_restore()
    CommandBars(cstr_Wmb).Visible = True
End Sub

'' ***************************************************************************
'' Purpose  : Restore the "Tester"
'' Written  : 05-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Sub tester_restore()
    CommandBars(cstr_MbTester).Visible = True
End Sub

'' ***************************************************************************
'' Purpose  : Deletes the named command bar
'' Written  : 05-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Sub DelCommandBar()
    DeleteCommandBar cstr_MbTester
End Sub

'' ***************************************************************************
'' Purpose  : Delete a named command bar control
''          : Cycle through all existing names - if our one exists, delete it
'' Written  : 28-Mar-2001 by Andy Wiggins, Byg Software Limited
''
Sub DeleteCommandBar(pstr_CbName)
Dim cb
    For Each cb In CommandBars
        If cb.Name = pstr_CbName Then
            cb.Delete
        End If
    Next
End Sub

'' ***************************************************************************
'' Purpose  : Creates a menubar
'' Written  : 05-Jul-2001 by Andy Wiggins, Byg Software Limited
''
Sub ReturnTestEditBoxValue()
    MsgBox CommandBars.FindControl(Tag:="TestEditBox").Text
End Sub