下面的代码大概是3年前写的，好像是借鉴excelhome上一位大大的代码。
把它放到你需要的xla的thisworkbook中，他在你的工具菜单中添加一项 "自定义命令"，并在你点选此菜单时运行程序subname：
Const APPNAME As String = "自定义命令"
Private Sub Workbook_AddinInstall()
'调用CreateMenu添加菜单
CreateMenu
MsgBox "已经生成菜单至:工具--自定义命令"
End Sub
Private Sub Workbook_AddinUninstall()
'调用DeleteMenu移除菜单
DeleteMenu
MsgBox "已经移除菜单:工具--自定义命令"
End Sub
Sub DeleteMenu()
Dim XLCommandBar As String
Dim XLMenu As String
Dim XLMenuItem As String
Dim NewMenuItem As String
XLCommandBar = "Worksheet Menu Bar"
XLMenuItem = ""
NewMenuItem = APPNAME & "..."
XLMenu = Application.CommandBars(XLCommandBar).FindControl(msoControlPopup, 30007).Caption
On Error Resume Next
Application.CommandBars(XLCommandBar).Controls(XLMenu).Controls(XLMenuItem).Controls(NewMenuItem).Delete
Application.CommandBars(XLCommandBar).Controls(XLMenu).Controls(NewMenuItem).Delete
End Sub
Sub CreateMenu()
Dim NewItem As CommandBarButton
Dim XLCommandBar As String
Dim XLMenu As String
Dim XLMenuItem As String
Dim NewMenuItem As String
XLCommandBar = "Worksheet Menu Bar"
XLMenu = Application.CommandBars(XLCommandBar).FindControl(msoControlPopup, 30007).Caption '我不敢确定30007这个ID总是ok
XLMenuItem = ""
NewMenuItem = APPNAME & "..."
On Error Resume Next
Application.CommandBars(XLCommandBar).Controls(XLMenu).Controls(XLMenuItem).Controls(NewMenuItem).Delete
Application.CommandBars(XLCommandBar).Controls(XLMenu).Controls(NewMenuItem).Delete
On Error GoTo 0
If XLMenuItem = "" Then
Set NewItem = Application.CommandBars(XLCommandBar).Controls(XLMenu).Controls.Add
Else
Set NewItem = Application.CommandBars(XLCommandBar).Controls(XLMenu).Controls(XLMenuItem).Controls.Add
End If
With NewItem
.Caption = NewMenuItem
.OnAction = "subname" '新菜单触发的过程名
.FaceId = 0
.BeginGroup = True
End With
Exit Sub
If Err <> 0 Then
MsgBox "菜单创建错误,请重新尝试", vbInformation, "提示"
End If
End Sub