In the .xls file, I've got:
In ThisWorkbook module:
Private Sub Workbook_Open()
Call CreateMenu
End Sub
In a standard module (courtesy of J-Walk):
I've got macros in other modules in this file. In the sheet set-up, I've got the menu layout/structure. I can upload a copy of the book if that'd help.Option Explicit Sub CreateMenu() ' This sub should be executed when the workbook is opened. ' NOTE: There is no error handling in this subroutine Dim MenuSheet As Worksheet Dim MenuObject As CommandBarPopup Dim MenuItem As Object Dim SubMenuItem As CommandBarButton Dim Row As Integer Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId Set MenuSheet = ThisWorkbook.Sheets("MenuSheet") Call DeleteMenu Row = 2 Do Until IsEmpty(MenuSheet.Cells(Row, 1)) With MenuSheet MenuLevel = .Cells(Row, 1) Caption = .Cells(Row, 2) PositionOrMacro = .Cells(Row, 3) Divider = .Cells(Row, 4) FaceId = .Cells(Row, 5) NextLevel = .Cells(Row + 1, 1) End With Select Case MenuLevel Case 1 ' A Menu Set MenuObject = Application.CommandBars(1). _ Controls.Add(Type:=msoControlPopup, _ Before:=PositionOrMacro, _ Temporary:=True) MenuObject.Caption = Caption Case 2 ' A Menu Item If NextLevel = 3 Then Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup) Else Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton) MenuItem.OnAction = PositionOrMacro End If MenuItem.Caption = Caption If FaceId <> "" Then MenuItem.FaceId = FaceId If Divider Then MenuItem.BeginGroup = True Case 3 ' A SubMenu Item Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton) SubMenuItem.Caption = Caption SubMenuItem.OnAction = PositionOrMacro If FaceId <> "" Then SubMenuItem.FaceId = FaceId If Divider Then SubMenuItem.BeginGroup = True End Select Row = Row + 1 Loop End Sub Sub DeleteMenu() Dim MenuSheet As Worksheet Dim Row As Integer Dim Caption As String On Error Resume Next Set MenuSheet = ThisWorkbook.Sheets("MenuSheet") Row = 2 Do Until IsEmpty(MenuSheet.Cells(Row, 1)) If MenuSheet.Cells(Row, 1) = 1 Then Caption = MenuSheet.Cells(Row, 2) Application.CommandBars(1).Controls(Caption).Delete End If Row = Row + 1 Loop On Error GoTo 0 End Sub
I'm then saving the book as an .xla, adding it to my add-in list via the Browse button.




Reply With Quote