將以下程式碼儲存到.xlam或.xla(Excel97-2003)檔案。

在ThisWorkBook物件中，新增Workbook_Open事件，呼叫啟動選單過程。
Private Sub Workbook_Open()
    Call MenuSetup(True)
End Sub

'-----------------------------------------------
'在Excel中新增選單和選單項按鈕（Excel啟動時候新增）
'-----------------------------------------------
Public Function MenuSetup(blSetUp As Boolean)
    Dim myMenu As CommandBarPopup
    Dim mycontrol As CommandBarControl
    Dim i As Integer
    Dim sMenuItemName As String     '選單項的名稱
    Dim sMenuItemFunc As String     '選單項的呼叫的函式名稱
    Dim strM As String              '選單名稱
    Dim strMenuItem() As String     '選單項名稱
 
    On Error Resume Next
    
    '初始化選單項
    ReDim strMenuItem(3, 2)    'VBA陣列下界從1開始
    '選單項1
    strMenuItem(1, 1) = "選單項1"
    strMenuItem(1, 2) = "選單1執行的過程名"
    '選單項2
    strMenuItem(2, 1) = "選單項2"
    strMenuItem(2, 2) = "選單2執行的過程名"
    
    Application.ScreenUpdating = False
    
    '---新增選單1
    strM = "EBS配套工具"
    Set myMenu = Application.CommandBars(1).Controls(strM)       '判斷我的選單是

否存在？
    If Err Then
        Err.Clear
        Set myMenu = Application.CommandBars(1).Controls.Add

(Type:=msoControlPopup, temporary:=True)
        myMenu.Caption = strM
    End If
    
    If blSetUp Then
            '---新增選單專案1
            For i = 1 To UBound(strMenuItem)      '陣列第一維的大小
                sMenuItemName = strMenuItem(i, 1)
                sMenuItemFunc = strMenuItem(i, 2)
                
                Set mycontrol = myMenu.Controls(sMenuItemName)   '判斷子程式是否

存在
                If Err Then
                    Err.Clear
                    Set mycontrol = myMenu.Controls.Add(Type:=msoControlButton, 

temporary:=True) '在菜欄最後位置增加一個按鈕
                    With mycontrol
                        .Caption = sMenuItemName                    '選單項顯示名

稱
                        .OnAction = sMenuItemFunc                   '左鍵單擊該菜

單項按鈕便執行的過程
                        .Style = msoButtonCaption                   '只顯示文字
                    End With
                End If
            Next
    Else
        Application.CommandBars(1).Controls(strT).Delete
       
    End If
    
    Application.ScreenUpdating = True
    If Err Then Err.Clear
End Function

Public Sub start_App()
 frmSetFileSheet.Show 0
End Sub