Add menus and menu item buttons in Excel through VBA (added when Excel starts)

Tag:vba   excel    add menu    

Save the following code to the. Xlam or. XLA (excel97-2003) file. In the ThisWorkbook object, add the Workbook_Open event, which invokes the Start menu procedure. Private Sub Workbook_Open () call Menusetup (True) End Sub '-----------------------------------------------' Add menus and menu item buttons in Excel (add when Excel starts) '-----------------------------------------------public Function menusetup (blsetup As Boolean) Dim myMenu As CommandBarPopup Dim mycontrol As CommandBarControl Dim i as Integer Dim Smenuitemnam e As String ' Name of the menu item Dim smenuitemfunc As String ' The function name of the call of the "Dim StrM As String ' MenuBar name Dim st Rmenuitem () As String ' menu item name on Error Resume Next ' Initialize menu item ReDim strmenuitem (3, 2) ' VBA array lower bound from 1 start ' menu Item 1 Strmenuitem (1, 1) = "menu item 1" Strmenuitem (1, 2) = "Menu 1 run Procedure name" ' Menu item 2 strmenuitem (2, 1) = "menu item 2" Strmenuitem ( 2, 2) = "Menu 2 run procedure name" application.screenupdating = False '---add menu 1 StrM = "EBS Kit" Set MyMenu = Applica tion. CommandBars (1).    Controls (StrM) ' Determine if my menu exists?       If ERR then Err.Clear Set MyMenu = Application.CommandBars (1).            Controls.Add (Type:=msocontrolpopup, temporary:=true) mymenu.caption = StrM End if Blsetup then '---Add menu item 1 for i = 1 to UBound (strmenuitem) ' array the size of the first dimension smenuitemname = Strmenuitem (i, 1 ) Smenuitemfunc = Strmenuitem (i, 2) Set mycontrol = Mymenu.controls (smenuite Mname) ' Determine if the subroutine exists if Err then err.clear Set mycontrol = Mymenu.cont Rols. Add (Type:=msocontrolbutton, temporary:=true) ' adds a button with mycontrol in the last position of the menu bar. Caption = Smenuitemname ' menu item display name. OnAction = Smenuitemfunc ' Left-click the menu item button to run the procedure. Style = msoButtonCaption ' only display text end With end If Next Els e Application.CommandBars (1). Controls (STRT).        Delete   End if application.screenupdating = True if Err then Err.clearend functionpublic Sub start_app () Frmsetfilesh Eet. Show 0End Sub

Add menus and menu item buttons in Excel through VBA (added when Excel starts)