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
  5. Private Sub Workbook_Open()
  6.     CreateMenu
  7. End Sub

Main code:

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

Settings file example:

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