How can I have a check mark not change on CommandBarPopup click

jnash67
jnash67 used Ask the Experts™
on
I have a custom menu on a commandbar with sub-menus of CommandBarPopup.  For some of these, only a single value is allowed to be selected.

So when a sub-menu item is clicked on, the onaction command makes sure the state value of the selected item is set to msoButtonDown and all the rest to msoButtonUp.

When an item is already selected (i.e. checked), if you click on it again, the code does the same thing.  It makes sure that item is msoButtonDown and the rest are msoButtonUp.

However, the checkmark disappears.  If you select a different menu and then go back, the checkmark shows up in the correct place.  It seems that Excel VBA has some default behavior on the click event that gets rid of the checkmark if one is already there.

I have tried a number of iterations involving making the menu item invisible (i.e visible = false) and then visible again, having screenupdating be set to false and then to true etc.  The checkmark will not re-appear until you click on a different menu and then go back again.

How can I programmatically make the checkmark stay there when a CommandBarPopup that is already checked is clicked?
' this works great, except when the checkmark is not supposed to toggle
    controlOnToolBar.Execute
    menuOnControl.Execute
    menuItem.Visible = False
    menuItem.Visible = True
    Application.ScreenUpdating = True

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2011
Top Expert 2011

Commented:
Perhaps you could post a sample demonstrating what you mean. I'm a little confused as to what commandbarpopups have to do with check marks.

Author

Commented:
I've prepared a demo that shows the problem.  Code shown below.  Run commandBarProblemDemo, select the Filter By menu on the command bar, and select Name 1 or Name 2 from the only sub-menu.  It will become checked. If you select it again, and move the mouse a bit to the left, the check will disappear, until you exit the menu and re-open it.  

It gets unchecked, despite the fact that all the code does is always turn it on (state msoButtonDown).

I've also attached a SWF flash video file showing the problem. To upload it, I had to rename the extension to JPG.  If you wish to view it, please rename it back to SWF and open in a browser with flash player installed. You should easily be able to see the problem without the video, though.

Option Explicit
 
Sub commandBarProblemDemo()
    Dim cbrBar As Office.CommandBar
    Dim filterMenu As CommandBarPopup
    Dim x As Office.CommandBarControl
    Dim c As Office.CommandBarControl
 
    Call deleteIfExists("Demo")
    Set cbrBar = Application.CommandBars.Add("Demo", 1, False, True)
 
    With cbrBar.Controls.Add(before:=1, Type:=MsoControlType.msoControlPopup, temporary:=True)
        .Caption = "Filter By"
        .BeginGroup = True
        Set filterMenu = cbrBar.Controls(.Index)
        .TooltipText = "Filter the data displayed by various criteria"
 
        With .Controls.Add(Type:=MsoControlType.msoControlPopup, temporary:=True)
            .Caption = "Filter By Name"
            Set c = .Controls.Add(Type:=MsoControlType.msoControlButton, temporary:=True)
            With c
                .Caption = "Name 1"
                .OnAction = "handleClick"
            End With
            Set c = .Controls.Add(Type:=MsoControlType.msoControlButton, temporary:=True)
            With c
                .Caption = "Name 2"
                .OnAction = "handleClick"
            End With
        End With
    End With
    Application.CommandBars("Demo").Visible = True
 
End Sub
 
Sub handleClick()
 
    Dim controlOnToolbar As CommandBarPopup
    Dim menuOnControl As CommandBarPopup
    Dim menuItem As CommandBarControl
                    
    Set controlOnToolbar = Application.CommandBars("Demo").Controls("Filter By")
    ' we know it's filter by name.  if we had more filters, the onaction would have to pass a parameter.
    Set menuOnControl = controlOnToolbar.Controls("Filter By Name")
    Set menuItem = menuOnControl.Controls(Application.Caller(1))
 
    ' do nothing
    menuItem.State = msoButtonDown
 
    controlOnToolbar.Execute
    menuOnControl.Execute
End Sub
 
Sub deleteIfExists(name As String)
    Dim i As Integer
    Dim numBars As Integer
 
    numBars = Application.CommandBars.Count
    i = 1
    While (i <= numBars)
        If (Application.CommandBars(i).name = name) Then
            Application.CommandBars(i).Delete
            numBars = numBars - 1
            ' don't exit for in case we have multiple
            ' Exit For
        End If
        i = i + 1
    Wend
 
End Sub

Open in new window

2009-10-29-1023.jpg
commandBarProblemDemo.xls

Author

Commented:
By the way, I tried using an event handler class instead of using onAction and that didn't work either
this happens somewhere upon startup to capture the events:
 
    ' Instantiate the control event handler class variable.
    Set gclsControlEvents = New clsButtonEvent
 
------
module clsButtonEvent
 
Option Explicit
 
Private WithEvents mctlPasteSpecial As Office.CommandBarButton
 
Private Sub Class_Terminate()
    Set mctlPasteSpecial = Nothing
End Sub
 
Private Sub mctlPasteSpecial_Click( _
        ByVal Ctrl As Office.CommandBarButton, _
        CancelDefault As Boolean)
    
    Dim controlOnToolbar As CommandBarPopup
    Dim menuOnControl As CommandBarPopup
    Dim menuItem As CommandBarControl
 
        CancelDefault = True
        Set controlOnToolbar = Application.CommandBars("Demo").Controls("Filter By")
        Set menuOnControl = controlOnToolbar.controls("Filter By Name")
        Set menuItem = Ctrl
 
        Ctrl.State = msoButtonDown
 
        controlOnToolbar.Execute
        menuOnControl.Execute
 
End Sub

Open in new window

Most Valuable Expert 2011
Top Expert 2011
Commented:
The issue seems to be executing the parent controls. See if this works better:
 

    menuItem.State = msoButtonDown
    controlOnToolbar.accDoDefaultAction
    menuOnControl.accDoDefaultAction

Open in new window

Author

Commented:
Amazing job figuring it out

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial