Dutch Gemini's Weblog Pages

December 30, 2008

Popup Menu on a Userform in Excel with VBA

Filed under: Excel,Programming,VBA — dutchgemini @ 8:52 pm
Tags: , , , , , ,

Article reviewed on July 05, 2012 – Contains working project at the end (link).

Ever thought possible to show a popup menu on an MSComCtl.ListView placed on a UserForm within an Excel Add-In (the ones ending with .XLA) using a right-click of the mouse, “just” VBA and no other Win32 function, class or wrapper? No? Then continue reading. If you think it is possible but you never tried or do not know how, read as well.

In my daily struggling with VBA I came finally on the “Golden Tip” that made it all possible. And, this method works on any type of control you place on the UserForm, as long as it can intercept mouse clicks (left, middle or right button is a matter of your choice).

History
I am developing an Add-In for Excel connecting to a database. The Add-In retrieves the data in pure or in aggregated form and lets you place the result as a matrix (records are rows and fields are columns) on a worksheet. The definition of what the Add-In retrieves from the database is defined as ‘query’. The query is also stored in the workbook, in a [very] hidden worksheet.

One of the features of the Add-In is allowing to slice and trim the result of a query by fetching only a few single rows of the resulting (ADODB) RecordSet. The slice and trim is defined as a ‘restriction’. The restrictions are managed via a UserForm which has the ListView with the individual restrictions in it.

Wish
My desire was adding a right-click popup menu letting me establish the logical link between a list item and its predecessor, selecting from this menu the ‘AND’ or the ‘OR’. I did not want to add another button control to avoid overloading the form (I already have 5 of such).

First implementation
After some investigation in Excel’s and MSDN’s help, I bounced into a popup menu provided natively by Excel via a CommandBar objects. I decided to use it. To obtain the functionality of the right-click popup menu on the ListView on my UserForm, I used:

  • The MouseUp Event of the ListView, where I could trap the right click and identify the current selected list item;
  • A CommandBar as the menu container, to be activated via the ‘.ShowPopup‘ method
  • Two CommandBarButtons to be placed ‘on’ the CommandBar, one for the AND and one for the OR
  • Subroutine for dealing with the factual changes, to be called via the ‘.OnAction‘ property of the CommandBarButton

In a popup menu, the 2 command bar buttons act as menu entries.

However, this code was not working. In other words, the popup menu did show, I could click but none of them triggered the execution of the associated subroutine procedures. Without raising any error. I was troubled.

Second and final implementation
On the Internet (which took some time in order to establish the right terms to feed into King Google) I got the hint I needed: instead of adding 2 generic command bar buttons, I had to create 2 private variables as command buttons in the declaration part of the UserForm using the ‘WithEvents’ to allow the buttons to react on my mouse click.

To make this example work, create a UserForm and place a ListView – a ListView ActiveX control 6.0, remember to add a reference in your project to Microsoft Common Controls 6.0 (SP6) – called ‘ListView1’. Somewhere in the code add one or more items to ListView1.

In the Declaration section of the UserForm:

Option Explicit ' Always recommended

Private WithEvents mButton1 As CommandBarButton ' Manages the first popup menu entry
Private WithEvents mButton2 As CommandBarButton ' Manages the second popup menu entry

In the MouseUp method of the ListView:

Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                              ByVal x As stdole.OLE_XPOS_PIXELS, _
                              ByVal y As stdole.OLE_YPOS_PIXELS)
On Error Resume Next
    Dim wListItem    As MSComctlLib.ListItem
    Dim wListItemTag As String

    ' We intercept only the 'RightClick' without any button pressed.
    '
    If (Button <> xlSecondaryButton) Or (Shift <> 0) Then GoTo EndSub

    ' Locate the element. We have used the Tooltip to know if this element needs to be modified.
    '
    Set wListItem = lstCustomRestrictions.SelectedItem
    If wListItem Is Nothing Then Set wListItem = lstCustomRestrictions.HitTest(x, y)
    If wListItem Is Nothing Then GoTo EndSub

    ' This line protects the first entry in the ListView.
    '
    If (wListItem.Index = 1) Then GoTo EndSub

    wListItem.Selected = True
    wListItemTag = wListItem.Tag  ' The Tag contains a specially crafted object.

    ' Show the popup menu.
    '
    ShowPopupMenu wListItemTag    ' The 'Tag' indicates 'Time' or 'Dutch'.

EndSub:
    Set wListItem = Nothing
End Sub

The Click event of the 2 buttons declared in the form:

Private Sub mButton1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error Resume Next
    If (Ctrl.State = msoButtonDown) _
    Then
        ' It was down, i.e. 'checked', so we need to uncheck and void.
        '
        SetToolTipText vbNullString
    Else
        ' It was up, i.e. 'unchecked', so we need to check and set.
        '
        SetToolTipText Ctrl.Parameter
    End If
End Sub

Private Sub mButton2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error Resume Next
    If (Ctrl.State = msoButtonDown) _
    Then
        ' It was down, i.e. 'checked', so we need to uncheck and void.
        '
        SetToolTipText vbNullString
    Else
        ' It was up, i.e. 'unchecked', so we need to check and set.
        '
        SetToolTipText Ctrl.Parameter
    End If
End Sub

This is the first custom private procedure (called from the MouseUp subroutine):

Private Sub ShowPopupMenu(pLinkType As String)
On Error Resume Next
    Dim wPopupMenu As Office.CommandBar    ' Used for right-click on ListView1
    Dim wListItem  As MSComctlLib.ListItem

    ' First try to locate this commandbar. If it exists, then we destroy ad make it again.
    ' The name of the menu is not important but should be unique.
    '
    Set wPopupMenu = Application.CommandBars.Item("UserForm1Popup")
    If Not wPopupMenu Is Nothing _
    Then
        wPopupMenu.Delete
        Set wPopupMenu = Nothing
    End If

    ' Create the menu.
    '
    Set wPopupMenu = Application.CommandBars.Add(Name:="UserForm1Popup", _
                                                 Position:=msoBarPopup, _
                                                 Temporary:=True)
    wPopupMenu.Enabled = True

    ' Add the first child menu item to the popup
    '
    Set mButton1 = Nothing
    Set mButton1 = wPopupMenu.Controls.Add(Type:=msoControlButton, ID:=1, _
                                           Parameter:="Time", Temporary:=True)
    With mButton1
        .Caption = "Set Tooltip to current date/time (i.e. 'Now')"
        .Enabled = True
        If (pLinkType = "Time") _
        Then
            .FaceId = 990           ' Show check mark
            .State = msoButtonDown  ' Show pressed
        End If
        .Style = msoButtonIconAndCaption
        .Visible = True
    End With

    ' Add the second child menu item to the popup
    '
    Set mButton2 = Nothing
    Set mButton2 = wPopupMenu.Controls.Add(Type:=msoControlButton, ID:=1, _
                                           Parameter:="Dutch", Temporary:=True)
    With mButton2
        .Caption = "Set Tooltip to 'Dutch Gemini'"
        .Enabled = True
        If (pLinkType = "Dutch") _
        Then
            .FaceId = 990           ' Show check mark
            .State = msoButtonDown  ' Show pressed
        End If
        .Style = msoButtonIconAndCaption
        .Visible = True
    End With

    ' Show as a popup close to the mouse pointer.
    '
    wPopupMenu.ShowPopup

    ' Destroy the internal popup menu.
    '
    If Not wPopupMenu Is Nothing Then wPopupMenu.Delete
    Set mButton2 = Nothing
    Set mButton1 = Nothing
    Set wPopupMenu = Nothing
End Sub

And the second custom private procedure:

Private Sub SetToolTipText(pToolTipType As String)
On Error Resume Next
    Dim wListItem As MSComctlLib.ListItem

    Set wListItem = ListView1.SelectedItem
    If wListItem Is Nothing Then GoTo EndSub

    ' This line protects the first entry in the ListView.
    '
    If (wListItem.Index = 1) Then GoTo EndSub

    wListItem.Tag = pToolTipType
    Select Case pToolTipType
    Case "Time"
        wListItem.TooltipText = VBA.CStr(Now)
    Case "Dutch"
        wListItem.TooltipText = "Dutch Gemini"
    Case Else
        wListItem.TooltipText = ""
    End Select

    wListItem.Selected = False

EndSub:
    Set wListItem = Nothing
End Sub

That’s it.

For convenience I have made this sample project available as an Excel workbook which contains the necessary overhead for making the above work out-of-the-box. It also contains some code dealing with the positioning of the UserForm on multiple-monitor systems. Click here to download a copy of this document.

If you like it then you can make me aware of your appreciation by making a small donation to help supporting my work.

Advertisements

8 Comments »

  1. I have a statistical data file in excel which excel4 macro language. But the customisable menus comes automatically in worksheet menu bar whenever i open the workbook. I tried to find out any code in excel4 macro sheet. But in vain. I tried in vba also whether there is any code. I also did not find anything !!!.

    The beauty is i made a copy of the workbook. I then deleted all the worksheets except one worksheet and saved. After that I reopened. Again the customised menus in worksheet menu bar appeared. I then went to vb script of the sheet and just added a full stop or a space in the script and saved. Now to my surprise the sheet name changed to workbook name and the customised menus in worksheet menu bar disappeared.

    How is it possible ? I verified the vbscript code also. There is no addition of customised menu through script als ? I am confused whether it is a macro virus or not ?

    Comment by Prakash.S. — June 4, 2010 @ 1:35 pm | Reply

    • Prakash,

      I actually have some difficulty seeing a relation with my post. Can you be more specific?

      Dutch

      Comment by dutchgemini — June 7, 2010 @ 8:50 am | Reply

  2. I have excel 2003, the vb help window shows version 6.5

    i tried this on a listbox in a form which i was using on a project but it failed to compile or run. I could provide feedback on that, but can i ask a question about your code first. Is this a platform on which your code can work? Ie open excel 2003, open vba, design a form, then add your code?

    thanks

    Brian

    Comment by Brian — March 11, 2012 @ 6:40 pm | Reply

    • Hi Brian,

      Exactly what is type here, yes.

      You may want to populate the List item’s “Tag” with an object (this can be a class) that contain a property called “.LinkToPrevious”. This would make the entire code run-worthy.

      I run this code on Excel from version 2000 all the way up to 2010 32-bit (my apps, because of a number of additional components, do not run on 64-bit Excel).

      In order to help you out of the situation, forward me copy of the error messages generated by the compiler and the location in the code snippets.

      Dutch

      Comment by dutchgemini — March 12, 2012 @ 9:24 am | Reply

  3. Can you please do me a favor and give me the class for the tag you’re referring to? Seems like an integer cannot be just a tag. I desperately need to make your code work, which always failed at the “Set wCriterion = wListItem.Tag” part inside the MouseUp event. Thanks in advance.

    Comment by Asep — June 1, 2012 @ 1:06 pm | Reply

    • The ‘.Tag’ can be anything, as long as it’s a valid thing VBA can handle. In my case, it is a user defined class object, and it is quite irrelevant what this class contains.

      Of course, you shall not forget that when the contents of ‘.Tag’ property is an object, then you must use a ‘Set oObject = .Tag’ statement otherwise you a statement like ‘vVariable = .Tag’ is enough.

      Hope this helps you out.

      Comment by dutchgemini — June 4, 2012 @ 8:46 am | Reply

      • Thank you for the helpful explanation. Much appreciated. Gotta give it a try, I mean creating a class or something like that to make the entire code snippet you provided work. 🙂

        Comment by Asep — June 5, 2012 @ 7:28 am

      • I’ve updated the post and made available a small working example at the bottom.

        Comment by dutchgemini — June 5, 2012 @ 9:39 am


RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Create a free website or blog at WordPress.com.

%d bloggers like this: