怎样使用VBA建立菜单式工作表目录？

1、首先在开发工具中打开VBA编辑器

2、在单元格区域当中输入一些内容作为例子

3、在VBA编辑器中插入模块

4、在模块当中输入如下代码，然后运行

Sub Auto_Open()

Dim BarCtlBtn As CommandBarButton
  '*********建立菜单按钮***************
    With Application.CommandBars("Worksheet Menu Bar").Controls
          .Add(Type:=msoControlButton)
          .Style=msoButtonIconAndCaption '有图标和文字
          .Caption="建立目录"
          .FaceId=481
          .OnAction="Create_contents"
      End With
End Sub
Sub Create_contents() '建立目录
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("工作表目录").Delete
Dim Sh As Worksheet
'添加新菜单
With Application.MenuBars(xlWorksheet).Menus.Add("工作表目录") '建立新菜单
'新菜单开始新组并添加文字提示
Set myMenuBar=CommandBars.ActiveMenuBar
Set lastctrl=myMenuBar.Controls(myMenuBar.Controls.Count)
  lastctrl.BeginGroup=True                                '开始新组
  lastctrl.TooltipText="建立工作表目录，单击可链接至相应工作表。"  '文字提示
'添加子菜单
For Each Sh In ActiveWorkbook.Sheets
 .MenuItems.Add Sh.Name, "into"          '添加子菜单，与工作表数目相同
  Next
.MenuItems.Add "请选择工作表名", "", , 1          '1表示移至第1个控件之前
.MenuItems.Add "刷新菜单目录", "f5"
End With
Application.CommandBars("Worksheet Menu Bar").Controls("建立目录")
.Visible=False
Call group
End Sub
Sub into() '进入工作表
  Dim Item As MenuItem
  Sheets(Application.CommandBars.ActionControl.Caption).Select
  '加选择框

With Application.MenuBars(xlWorksheet).Menus("工作表目录")

    For Each Item In .MenuItems
      Item.Checked=False
Next Item
.MenuItems(Application.CommandBars.ActionControl.Caption).Checked=True
End With
End Sub
Sub f5()
Call Create_contents
End Sub
Sub group() '为菜单设置图标
Dim Y As Byte
Y=Application.CommandBars("Worksheet Menu Bar").Controls("工作表目录").
Controls.Count
With Application.CommandBars("Worksheet Menu Bar").Controls("工作表目录")
.Controls(1).FaceId=176
.Controls(2).BeginGroup=True
.Controls(Y).BeginGroup=True
.Controls(Y).FaceId=481
If .Controls(2).Caption="工作表目录" Then .Controls(2).Delete

'  End If

End With
End Sub
Sub auto_close() '关闭工作表时删除菜单
Application.CommandBars(1).Reset
End Sub

5