How to make popup menu with form/ActiveX controls?

Special K

Board Regular
Joined
Jun 20, 2011
Messages
62
My spreadsheet is getting too cluttered with buttons, menus, text boxes, etc. Is it possible to create a custom popup menu that contains multiple form/ActiveX controls and appears when the user clicks a button on the spreadsheet? I found this basic tutorial here:

https://msdn.microsoft.com/es-es/library/office/gg987030(v=office.14).aspx

but it only covers creating a simple selection menu. So far my searching hasn't turned up any examples of creating a custom popup menu with form controls like you would see in an actual windows application, such as Excel itself.

Is what I'm trying to do possible in Excel, or do I need to make a full-blown C# application to have popup menus with their own controls, tabs, etc.?
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,803
.
Here is part of the code :

Code:
Option Explicit
Option Base 1
'---------------------------------------------------------------------------------------
' Module    : basMenuAPIMNU
' DateTime  : 05/01/05 14:33
' Author    : Ivan F Moala
' Site      : http://www.xcelfiles.com
' Purpose   : Creates Windows Menu using API's
'---------------------------------------------------------------------------------------


'// Creates a horizontal menu bar @ the top, suitable for attaching to a top-level window.
'// eg [File], [Edit] etc and usually ending in Help
'// That's the Basic Format.. with [Windows] usually 2nd to last.
Public Declare Function CreateMenu _
    Lib "user32" () _
As Long


Public Declare Function CreatePopupMenu _
    Lib "user32" () _
As Long


Public Declare Function FindWindow _
    Lib "user32" _
        Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) _
As Long


Public Declare Function GetMenu _
    Lib "user32" ( _
    ByVal hwnd As Long) _
As Long


Public Declare Function AppendMenu _
    Lib "user32" _
        Alias "AppendMenuA" ( _
            ByVal hMenu As Long, _
            ByVal wFlags As Long, _
            ByVal wIDNewItem As Long, _
            ByVal lpNewItem As String) _
As Long


Public Declare Function SetMenu _
    Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal hMenu As Long) _
As Long


Public Declare Function DestroyMenu _
    Lib "user32" ( _
        ByVal hMenu As Long) _
As Long


Public Declare Function SetWindowLong _
    Lib "user32" _
        Alias "SetWindowLongA" ( _
            ByVal hwnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) _
As Long


Public Const MF_SEPARATOR As Long = &H800&
Public Const MF_POPUP = &H10
Public Const MF_STRING = &H0




Public Const IDM_MU As Long = &H7D0 '// Our Menu Item ID
'//
Public g_hPopUpMenu() As Long       '// Holds Popupmenu handles
Public g_hMenu As Long              '// Userform menu handle
Public g_hPopUpSubMenu() As Long    '// Holds Submenu handles
Public g_Rt() As Long               '// Holds return Values for testing debuging
Public g_APIMacro() As String       '// Holds Routine names associated with Menus
Public g_hForm As Long              '// Userform handle
Public g_MNUSheet As Worksheet      '// Menu Sheet


Public Sub CreateAPIMenu()
'// This sub should be executed when the Userform is Initialised.
Dim RowNum As Long, _
    SubMNU As Long, _
    TopMNUitems As Long, _
    SubMNUItem As Long, _
    TopMNU As Long, _
    Rt As Long, _
    MacroNum As Long


'// Set menusheet
Set g_MNUSheet = ThisWorkbook.Sheets("APIMNU")


With g_MNUSheet
    '// Set-up now
    TopMNUitems = .Range("A1") '// Number of Top Level
    SubMNU = .Range("B1")      '// Number of Sub Menus
    
    ReDim g_hPopUpMenu(TopMNUitems)      '//
    ReDim g_Rt(TopMNUitems)              '//
    ReDim g_hPopUpSubMenu(SubMNU)        '//
    ReDim g_APIMacro(.Range("C1").Value) '//
    
    '// Create Main Menu Area @ Top of Userform
    g_hMenu = CreateMenu()
    Rt = SetMenu(g_hForm, g_hMenu)
    
    '// Initialize variables
    RowNum = 0
    MacroNum = 1
    SubMNUItem = LBound(g_hPopUpSubMenu)
    
    For TopMNU = 1 To TopMNUitems
        RowNum = RowNum + 1
        '// AppendMenu(g_hMenu, MF_POPUP, hPopUpMenu1, "&File")
        '// Create our Top Menu
        g_hPopUpMenu(TopMNU) = CreatePopupMenu()
        '// For 1st Menu Index is (2 + RowNum) after which it is (1 + RowNum)
        If TopMNU = 1 Then
            g_Rt(TopMNU) = AppendMenu(g_hMenu, MF_POPUP, g_hPopUpMenu(TopMNU), .Cells(2 + RowNum, 2))
        Else
            g_Rt(TopMNU) = AppendMenu(g_hMenu, MF_POPUP, g_hPopUpMenu(TopMNU), .Cells(1 + RowNum, 2))
        End If
        '// Do until we get to the END of the Menu = New TOP LEVEL MENU Starts!
        Do Until .Cells(2 + RowNum, 4).Text = "END"
            Select Case .Cells(2 + RowNum, 1).Value
                Case 1
                    '// Do nothing for Testing
                Case 0
                    '// Menu Seperator/Divider ... IDM_MU + Cells(2 + RowNum, 5)
                    '// AppendMenu(hPopUpMenu1, MF_SEPARATOR, IDM_MU + num, vbNullString)
                    '// If it is within Submenu to a Submenu then....
                    If .Cells(1 + RowNum, 1) = 4 Then
                        g_Rt(TopMNU) = AppendMenu(g_hPopUpSubMenu(SubMNUItem - 1), _
                            MF_SEPARATOR, &O0, vbNullString)
                    Else
                        g_Rt(TopMNU) = AppendMenu(g_hPopUpMenu(TopMNU), _
                            MF_SEPARATOR, &O1, vbNullString)
                    End If
                Case 2
                    '// STD Sub
                    '// AppendMenu(hPopUpMenu1, MF_STRING, IDM_MU + num, " &New task (Run...)")
                    g_Rt(TopMNU) = AppendMenu(g_hPopUpMenu(TopMNU), MF_STRING, _
                        IDM_MU + .Cells(2 + RowNum, 5), .Cells(2 + RowNum, 2))
                    '// Update our Routine to Run here
                    g_APIMacro(MacroNum) = .Cells(2 + RowNum, 3).Text
                    MacroNum = MacroNum + 1
                Case 3
                    '// A SUBMENU Caption = 3
                    g_hPopUpSubMenu(SubMNUItem) = CreatePopupMenu()
                    '// AppendMenu(g_hMenu, MF_POPUP, hPopUpSubMenu1, vbNullString)
                    g_Rt(TopMNU) = AppendMenu(g_hPopUpMenu(TopMNU), MF_POPUP, _
                        g_hPopUpSubMenu(SubMNUItem), .Cells(2 + RowNum, 2))
                    SubMNUItem = SubMNUItem + 1
                 Case 4
                    '// A SUBMENUITEM = 4
                    '// AppendMenu(hPopUpSubMenu1, MF_STRING, IDM_MU + num, "SubMNU &1")
                    '// OK, lets build our sub Menu
                    g_Rt(TopMNU) = AppendMenu(g_hPopUpSubMenu(SubMNUItem - 1), _
                        MF_STRING, IDM_MU + .Cells(2 + RowNum, 5), .Cells(2 + RowNum, 2))
                    '// Update our Routine to Run here
                    g_APIMacro(MacroNum) = .Cells(2 + RowNum, 3).Text
                    MacroNum = MacroNum + 1
                End Select
            RowNum = RowNum + 1
        Loop
    Next TopMNU
End With


End Sub


Public Sub RunAPIMNUMacro(strMacroName As String)
    On Error Resume Next
    Application.Run (strMacroName)
    If Err Then
        MsgBox "Error number:=" & Err.Number & vbCrLf & _
            "Description:=" & Err.Description & vbCrLf & _
            "Check yur macro names!", vbCritical + vbMsgBoxHelpButton, _
            "Menu Macro Error", Err.HelpFile, Err.HelpContext
    End If
    Err.Clear
End Sub

Download workbook example : https://www.amazon.com/clouddrive/share/IVwo3ZJWZXaz06JCnhLp17thgpnJR3c9oRfSdHNAt6x

Admittedly, you will have to 'stumble through it' as much as I would. Just use the preprogrammed example and manipulate it to suit.
 

Special K

Board Regular
Joined
Jun 20, 2011
Messages
62
Thanks for the links, however I just discovered Excel VBA User Forms and I think they have all the functionality I need for now. I'm not sure how my previous searches never turned up any results for them.
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,849
You might consider a floating command bar
Code:
Sub makeCommandBar()
    Dim newBar As CommandBar

    Rem clear old bar (if any)
    On Error Resume Next
        Application.CommandBars("KDVS").Delete
    On Error GoTo 0

    Rem make new bar
    Set newBar = Application.CommandBars.Add("KDVS", Position:=msoBarFloating, temporary:=True)
    With newBar
        .Width = 135
        
        Rem add buttons

        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = True
            .Style = msoButtonCaption
            .Caption = "Get From Spotify"
            .Visible = True
            .OnAction = "ImportFromSpotify"
            .Width = 130
        End With
        
        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = False
            .Style = msoButtonCaption
            .Caption = "iTunes import"
            .Visible = True
            .OnAction = "ImportFromITunes"
            .Width = 130
        End With
   
        .Top = 200
        .Left = 900
        .Visible = True
    End With
End Sub

Sub ImportFromITunes()
    Rem do something
End Sub
Sub ImportFromSpotify()
    Rem do something else
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,119,107
Messages
5,576,146
Members
412,701
Latest member
Yong girl
Top