Create custom menu based on a text list

Tested in Excel 365 (16.0.11601.20184) 64-bit. 

When you have a bunch of macros that you use frequently, a menu containing all of them, structured by functionality, would be a great help.

Here is some code that would read any text file (txt, csv etc) and will build your menu when you open Excel. This code needs to be called either on Workbook_Open or in Auto_Open subs.

Also a piece of code will delete the menu when you close Excel. This one needs to be called in either Workbook_BeforeClose or Auto_Close.

While Auto_Open and Auto_Close can be put anywhere, the other two need to be placed on ThisWorkbook (above Modules, expand Microsoft Excel Objects and double-click ThisWorkbook.

 
 
  1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  2.     DeleteMenu
  3. End Sub
  4. Private Sub Workbook_Open()
  5.     CreateMenu
  6. End Sub

Main code:

 
 
  1. Option Explicit
  2. Public Const TopLevelMenuName = "MyMacros"
  3. Public Const MenuFile = "MyMenu.csv"
  4. Public Const xlsMenuBar = "Worksheet Menu Bar"
  5. Sub CreateMenu()
  6.     ' inspired from https://sitestory.dk/excel_vba/user-defined-menu.htm
  7.     ' needs reference to Microsoft Scripting Runtime
  8.     Dim cbMainMenu As CommandBar
  9.     Dim TopLevelMenu As CommandBarControl
  10.     Dim SubMenu As CommandBarControl, tempMenu As CommandBarControl
  11.     Dim MySettings As New Dictionary
  12.     Dim dKey, arrTemp, i
  13.    
  14.     Set MySettings = GetMenuSettings
  15.    
  16.     ' Delete the menu if it exists
  17.    On Error Resume Next
  18.     Application.CommandBars(xlsMenuBar).Controls(TopLevelMenuName).Delete
  19.     On Error GoTo 0
  20.      
  21.     'Set a CommandBar variable as a Worksheet menu bar
  22.    Set cbMainMenu = Application.CommandBars(xlsMenuBar)
  23.    
  24.     ' add top level menu
  25.    Set TopLevelMenu = cbMainMenu.Controls.Add(Type:=msoControlPopup)
  26.     TopLevelMenu.Caption = TopLevelMenuName
  27.    
  28.     ' open the csv settings files and build the menu
  29.    For Each dKey In MySettings
  30.         arrTemp = Split(dKey, ",")
  31.         If dKey <> "Submenu,Caption,OnAction,FaceID" Then
  32.             ' check if submenu exists and add it if not
  33.            On Error Resume Next
  34.             tempMenu = Nothing
  35.             Set tempMenu = TopLevelMenu.Controls(arrTemp(0))
  36.             On Error GoTo 0
  37.             If tempMenu Is Nothing Then
  38.                 Set SubMenu = TopLevelMenu.Controls.Add(Type:=msoControlPopup)
  39.                 SubMenu.Caption = arrTemp(0)
  40.                 Set SubMenu = TopLevelMenu.Controls(arrTemp(0))
  41.             End If
  42.             ' add macro
  43.            With SubMenu.Controls.Add(Type:=msoControlButton)
  44.                .Caption = arrTemp(1)
  45.                .OnAction = arrTemp(2)
  46.                .FaceId = arrTemp(3)
  47.             End With
  48.             Set tempMenu = Nothing
  49.         End If
  50.    
  51.     Next
  52.    
  53.     Set TopLevelMenu = Nothing
  54.     Set SubMenu = Nothing
  55.     Set cbMainMenu = Nothing
  56.     Set MySettings = Nothing
  57.     Set tempMenu = Nothing
  58.    
  59. End Sub
  60. Sub DeleteMenu()
  61.     'Deletes the user defined menu
  62. '    Application.CommandBars("Worksheet Menu Bar").Reset
  63.    On Error Resume Next
  64.     Application.CommandBars(xlsMenuBar).Controls(TopLevelMenuName).Delete
  65. End Sub
  66. Function GetMenuSettings() As Dictionary
  67.     ' needs reference to Microsoft Scripting Runtime
  68.    Dim f, MyDoc
  69.     Dim strFile
  70.     Dim dSettings As New Dictionary
  71.    
  72.     f = FreeFile
  73.     strFile = ""
  74.     MyDoc = Environ("USERPROFILE") & "\Documents\"
  75.     Open MyDoc & MenuFile For Input As #f
  76.     ' parse the file
  77.    Do Until EOF(f)
  78.         Line Input #f, strFile
  79.         If Left(strFile, 1) <> ConfigComment Then
  80.             ' add to dictionary
  81.            If Not dSettings.Exists(strFile) Then _
  82.                 dSettings.Add Trim(strFile), Trim(strFile)
  83.         End If
  84.     Loop
  85.    
  86.     Close #f
  87.    
  88.     Set GetMenuSettings = dSettings
  89.     ' discard the dictionary
  90.    Set dSettings = Nothing
  91.    
  92. End Function

Settings file example:

 
 
  1. Submenu,Caption,OnAction,FaceID
  2. Main subs,Stats,not_yet,0001
  3. Grooming,Unhide All Cols And Rows,UnhideAllColsAndRows,0164
  4. Grooming,Extract URL From Shape,ExtractURLFromShape,0098
  5. Grooming,Extract URL From Text,ExtractURLFromText,0099
  6. Grooming,Create Summary sheet,CreateSheetNameLinks,0247
  7. Tools,Excel Functionalities ON,ExcelFunctionalitiesON,0156
  8. Tools,List all comments,ListComments,0170
  9. Tools,List files or folders,ListFilesOrFolders,0085
  10. Tools,List File properties (no subfolders),ListFileProperties,0188
  11. Tools,Merge files,MergeExcelTextFiles,1642
  12. Tools,Copy Files,CopyFiles,0053