Excel：Customize Menu 如何加入自訂功能表 - 範例 (二)

Excel：Customize Menu 如何加入自訂功能表 - 範例 (二)：

範例 1：
複製並貼上在Module1
Option Explicit
Option Private Module 'prevent menu macros appearing under Tools|Macros

Sub CreateMenu()
Dim MenuObject As CommandBarPopup, MenuItem As Object
Dim SubMenuItem As CommandBarButton, Sh As Worksheet, i As Long

' 檢查是否有相同
Call DeleteMenu

' 建立主功能表
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, Temporary:=True)
'Name of top level menu. Remember to also change caption in DeleteMenu macro
MenuObject.Caption = "&Custom Menu"   '主功能表

'Add 1st menu item - 建立功能表上的自訂命令控制項
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
MenuItem.Caption = "Go To Sheet"

    'Add sub menu items to 1st menu - 建立副功能表
    For Each Sh In ThisWorkbook.Sheets
        i = i + 1
        Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
        SubMenuItem.Caption = Sh.Name       '副功能表
        SubMenuItem.OnAction = "'LinkSheet(" & i & ")'"
        If ActiveSheet.Name = Sh.Name Then SubMenuItem.FaceId = 1087
    Next Sh

'Add 2nd menu item - 建立功能表上的自訂命令控制項
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.Caption = "Test SubMenu"

'Add 3rd menu item - 刪除自訂命令列
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.BeginGroup = True      '將分隔線新增到功能表控制項
MenuItem.Caption = "Delete Menu"
MenuItem.OnAction = "DeleteMenu"

'Add 4th menu item - 建立功能表上的自訂命令控制項
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.BeginGroup = True      '將分隔線新增到功能表控制項
MenuItem.Caption = "Add SubMenu"
MenuItem.OnAction = "Add_SubMenu"

'Add 5th menu item - 刪除自訂命令列
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.Caption = "Delete SubMenu"
MenuItem.OnAction = "Delete_SubMenu"

'Add 6th menu item - 啟用命令列上的命令控制項
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.Caption = "Enable SubMenu"
MenuItem.OnAction = "Enable_SubMenu"

'Add 7th menu item - 停用命令列上的命令控制項
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.Caption = "Disable SubMenu"
MenuItem.OnAction = "Disable_SubMenu"

End Sub

'選擇工作表
Sub LinkSheet(ShtName As Integer)
If IsMissing(ShtName) Then Exit Sub

On Error Resume Next
Sheets(ShtName).Select
Range("A1").Select
On Error GoTo 0
End Sub

' 刪除自訂命令列
Sub DeleteMenu()
    On Error Resume Next
    'Change &Custom Menu to the menu name you want
    Application.CommandBars(1).Controls("&Custom Menu").Delete
    On Error GoTo 0
End Sub

' 建立功能表上的自訂命令控制項
Sub Add_SubMenu()
Dim newSubItem As Object
   Set newSubItem = CommandBars(1).Controls("&Custom Menu")
   With newSubItem
      .Controls.Add(Type:=msoControlButton, Before:=2).Caption = "Test SubMenu"
      .Controls("Test SubMenu").OnAction = "Code_SubItem1"
   End With
End Sub

' 刪除自訂子功能表
Sub Delete_SubMenu()
   Application.CommandBars(1).Controls("&Custom Menu").Controls("Test SubMenu").Delete
End Sub

' 啟用命令列上的命令控制項
Sub Enable_SubMenu()
   Application.CommandBars(1).Controls("&Custom Menu").Controls("Test SubMenu").Enabled = True
End Sub

' 停用命令列上的命令控制項
Sub Disable_SubMenu()
   Application.CommandBars(1).Controls("&Custom Menu").Controls("Test SubMenu").Enabled = False
End Sub

範例 2：
複製並貼上在ThisWorkbook
Option Explicit

Private Sub Workbook_Activate()
CreateMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteMenu
End Sub

Private Sub Workbook_Deactivate()
DeleteMenu
End Sub

Private Sub Workbook_Open()
CreateMenu
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
DeleteMenu
CreateMenu
End Sub

相關網頁：
Excel：Customize Menu 如何加入自訂功能表 (一)
Excel：Customize Menu 如何加入自訂功能表  - 範例 (二)