MenuItem Check Mark

  • Thread starter Thread starter scott
  • Start date Start date
S

scott

I've having a problem referencing a sub menu item on my custom menu, "My
Menu". My sub CreateMyMenu() below creates a new menu "My Menu" that
contains a "Options" group. The "Options" group contains 2 items called
"Option 1" and "Option 2". The purpose of the sub CreateMyMenu() is to test
and set the .State property of "Option 1" menu item.

The problem occurs within my SetMenuItemChecked() sub. When I attempt to
reference the "Option 1" menu item with the line
If mypopup.Controls("Option 1").State =
msoButtonDown Then

I get an error. I think it maybe because this is a sub menu item instead of
just a regular or "level 1" menu item.

Can someone take a look at my code example and help me modify the problem
line so I can correctly reference the .State property of the "Option 1" menu
item?

* Note: I also included the RemoveMenu() sub so if someone tests my code,
there is a menu option to remove the menu.



' CODE: *******************************

Sub CreateMyMenu()

On Error Resume Next
Application.CommandBars("My Menu").Delete
On Error GoTo 0

Dim HelpMenu As CommandBarControl, NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl, SubMenuItem As CommandBarButton

' Delete the menu if it already exists
Call RemoveMenu

' Find the Help Menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)

If HelpMenu Is Nothing Then
' Add the menu to the end
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
temporary:=True)
Else
' Add the menu before Help
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
Before:=HelpMenu.Index, _
temporary:=True)
End If

' Add a caption for the menu
NewMenu.Caption = "&My Menu"

' 1st main menu item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlPopup)
With MenuItem
.Caption = "Options"
.BeginGroup = True
End With

' 1st submenu item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "&Option 1"
.OnAction = "SetMenuItemChecked"
End With

' 2nd submenu item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Option 2"
End With

' add a menu to restore the original menus
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Remove Menu"
.OnAction = "RemoveMenu"
.BeginGroup = True
End With

End Sub

Sub SetMenuItemChecked() 'show or hide check mark for Option 1 Sub Menu
Item
Dim mypopup As CommandBarPopup
Set mypopup = CommandBars(1).Controls("My Menu")

If mypopup.Controls("Option 1").State = msoButtonDown Then

'remove check next to menu item
mypopup.Controls("Option 1").State = msoButtonUp
MsgBox "menu item is now unchecked"
Else

'add check next to menu item
mypopup.Controls("Option 1").State = msoButtonDown
MsgBox "menu item is now checked"
End If
End Sub


Sub RemoveMenu()
On Error Resume Next
CommandBars(1).Controls("My Menu").Delete
End Sub
 
I figured it out.

Sub CreateMyMenu()

On Error Resume Next
Application.CommandBars("My Menu").Delete
On Error GoTo 0

Dim HelpMenu As CommandBarControl, NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl, SubMenuItem As CommandBarButton

' Delete the menu if it already exists
Call RemoveMenu

' Find the Help Menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)

If HelpMenu Is Nothing Then
' Add the menu to the end
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
temporary:=True)
Else
' Add the menu before Help
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
Before:=HelpMenu.Index, _
temporary:=True)
End If

' Add a caption for the menu
NewMenu.Caption = "&My Menu"

' 1st main menu item
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlPopup)
With MenuItem
.Caption = "Options"
.BeginGroup = True
End With

' 1st submenu item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "&Option 1"
.OnAction = "SetMenuItemChecked"
End With

' 2nd submenu item
Set SubMenuItem = MenuItem.Controls.Add _
(Type:=msoControlButton)
With SubMenuItem
.Caption = "Option 2"
End With

' add a menu to restore the original menus
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "Remove Menu"
.OnAction = "RemoveMenu"
.BeginGroup = True
End With

End Sub

Sub SetMenuItemChecked() 'show or hide check mark for Protection

If CommandBars("Worksheet menu bar").Controls("My Menu") _
.Controls("Options").Controls("Option 1").State = msoButtonDown Then

CommandBars("Worksheet menu bar").Controls("My Menu") _
.Controls("Options").Controls("Option 1").State = msoButtonUp
MsgBox "menu item is now unchecked"
Else

CommandBars("Worksheet menu bar").Controls("My Menu") _
.Controls("Options").Controls("Option 1").State = msoButtonDown
MsgBox "menu item is now checked"
End If
End Sub


Sub RemoveMenu()
On Error Resume Next
CommandBars(1).Controls("My Menu").Delete
End Sub
 
Back
Top