ExcelVBA创建自己的工具栏和菜单

 Excel VBA创建自己的工具栏和菜单 收藏
Option Explicit
'msoBarTop工具栏的Position
'Type为msoControlPopup(As CommandBarPopup)的菜单下可以带子菜单,但是msoControlPopup不支持图标
'Type为msoControlButton(As CommandBarButton)的菜单是msoControlPopup的下级菜单,不带子菜单,支持图标
'以下代码可以实现将自己的菜单添加到Excel菜单栏上及创建自己的工具栏和菜单的功能,更改代码可以实现创建多级菜单,下面的代码只创建了二级菜单
'更改以下代码可以创建你所需要的菜单
'ShortcutText属性表示菜单的快捷键

'添加菜单到指定的现有工具栏上
Function AddMenuToCommandBar(ByVal Index As Integer, ByVal TopMenuName As String)
On Error Resume Next
Application.CommandBars(1).Controls(TopMenuName).Delete '如果存在就删除以前的菜单
On Error GoTo 0

Dim TopMenuItem As CommandBarPopup '顶层菜单
Dim FirstMenuItem As CommandBarPopup '一级子菜单
Dim SecondMenuItem As CommandBarButton '二级子菜单

'顶层菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set TopMenuItem = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup)
    With TopMenuItem
        .Caption = TopMenuName '顶层菜单名
        .TooltipText = "TopMenuItem TooltipText" '菜单提示文字
    End With

'一级子菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set FirstMenuItem = TopMenuItem.Controls.Add(Type:=msoControlPopup)
    With FirstMenuItem
        .Caption = "FirstMenuItem(&F)" '一级菜单名
        .TooltipText = "FirstMenuItem TooltipText" '菜单提示文字
    End With

'二级菜单CommandBarButton,支持图标(只有最后一级菜单才支持图标)
Set SecondMenuItem = FirstMenuItem.Controls.Add(Type:=msoControlButton)
    With SecondMenuItem
        .Caption = "SecondMenuItem(&S)" '二级菜单名
        .TooltipText = "SecondMenuItem TooltipText" '菜单提示文字
        .Style = msoButtonIconAndCaption '菜单样式(图标加文字)
        .FaceId = 263 '图标代号
        .ShortcutText = "Ctrl+Shift+S"
        .OnAction = "Macro" '要执行的子程序
        .BeginGroup = True '添加分割线
    End With
End Function

'创建工具栏,并且添加自己的菜单到新建的工具栏
Function CreateCommandBarAndMenu(ByVal CommandBarName As String, ByVal TopMenuName As String)
On Error Resume Next
Application.CommandBars(CommandBarName).Delete '如果存在就删除以前的菜单
On Error GoTo 0

Dim MyCommandBar As CommandBar '工具栏
Dim TopMenuItem As CommandBarPopup '顶层菜单
Dim FirstMenuItem As CommandBarPopup '一级子菜单
Dim SecondMenuItem As CommandBarButton '二级子菜单

'工具栏
Set MyCommandBar = Application.CommandBars.Add() '创建工具栏(空白)
    With MyCommandBar
        .Visible = True
        .Name = CommandBarName '工具栏的名字
        .Position = msoBarTop 'msoBarMenuBar '工具栏的Position
    End With
   
'顶层菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set TopMenuItem = MyCommandBar.Controls.Add(Type:=msoControlPopup)
    With TopMenuItem
        .Caption = TopMenuName '顶层菜单名
        .TooltipText = "TopMenuItem TooltipText" '菜单提示文字
    End With

'一级子菜单CommandBarPopup,不支持图标(只有最后一级菜单才支持图标)
Set FirstMenuItem = TopMenuItem.Controls.Add(Type:=msoControlPopup)
    With FirstMenuItem
        .Caption = "FirstMenuItem(&F)" '一级菜单名
        .TooltipText = "FirstMenuItem TooltipText" '菜单提示文字
    End With
   
'二级菜单CommandBarButton,支持图标(只有最后一级菜单才支持图标)
Set SecondMenuItem = FirstMenuItem.Controls.Add(Type:=msoControlButton)
    With SecondMenuItem
        .Caption = "SecondMenuItem(&S)" '二级菜单名
        .TooltipText = "SecondMenuItem TooltipText" '菜单提示文字
        .Style = msoButtonIconAndCaption '菜单样式(图标加文字)
        .FaceId = 263 '图标代号
        .ShortcutText = "Ctrl+Shift+S"
        .OnAction = "Macro" '要执行的子程序
        .BeginGroup = True '添加分割线
    End With
End Function

发表于 @

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/c_cwh/archive/2009/10/05/4633699.aspx