电脑技术学习

Excel 2007 自定义菜单技术(2)(1)

dn001

  在Excel 97至Excel 2003等版本中,可以利用“自定义对话框来创建新菜单,并建立菜单项,但很难创建子菜单。因此,特定的工作簿菜单必须编写VBA代码来创建。下面的技术介绍了使用一种相当简单的方法在工作表菜单栏中创建自定义菜单,当工作簿打开时则显示自定义的菜单,该工作簿关闭时则删除自定义的菜单。

  先来看看一个示例,该示例演示了这项技术。点此下载这个示例(menumakr)。

  示例文件包含了所有需要创建自定义菜单的VBA代码,在大多数情况下,不需要改变这些代码,只需按自已的意图简单地自定义MenuSheet工作表即可。VBA代码清单如下:

Sub CreateMenu()
'  当工作簿打开时本过程自动执行.
'  注:在这个子过程中没有错误处理语句.
  Dim MenuSheet As Worksheet
  Dim MenuObject As CommandBarPopup
  Dim MenuItem As Object
  Dim SubMenuItem As CommandBarButton
  Dim Row As Integer
  Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''''
'  获取菜单数据的位置
  Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
'  确保菜单不重复
  Call DeleteMenu
 
'  行初始值
  Row = 2
'  使用MenuSheet工作表中的数据添加菜单,菜单项和子菜单项
  Do Until IsEmpty(MenuSheet.Cells(Row, 1))
    With MenuSheet
      MenuLevel = .Cells(Row, 1)
      Caption = .Cells(Row, 2)
      PositionOrMacro = .Cells(Row, 3)
      Divider = .Cells(Row, 4)
      FaceId = .Cells(Row, 5)
      NextLevel = .Cells(Row + 1, 1)
    End With
   
    Select Case MenuLevel
      Case 1 '代表菜单
'       添加顶级菜单到工作表菜单栏中
        Set MenuObject = Application.CommandBars(1). _
          Controls.Add(Type:=msoControlPopup, _
          Before:=PositionOrMacro, _
          Temporary:=True)
        MenuObject.Caption = Caption
     
      Case 2' 代表菜单项
        If NextLevel = 3 Then
          Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
        Else
          Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
          MenuItem.OnAction = PositionOrMacro
        End If
        MenuItem.Caption = Caption
        If FaceId <> "" Then MenuItem.FaceId = FaceId
        If Divider Then MenuItem.BeginGroup = True
     
      Case 3 ' 代表子菜单项
        Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
        SubMenuItem.Caption = Caption
        SubMenuItem.OnAction = PositionOrMacro
        If FaceId <> "" Then SubMenuItem.FaceId = FaceId
        If Divider Then SubMenuItem.BeginGroup = True
    End Select
    Row = Row + 1
  Loop
End Sub
Sub DeleteMenu()
'  这个子过程在工作簿关闭时执行
'  删除自定义菜单
  Dim MenuSheet As Worksheet
  Dim Row As Integer
  Dim Caption As String
 
  On Error Resume Next
  Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
  Row = 2
  Do Until IsEmpty(MenuSheet.Cells(Row, 1))
    If MenuSheet.Cells(Row, 1) = 1 Then
      Caption = MenuSheet.Cells(Row, 2)
      Application.CommandBars(1).Controls(Caption).Delete
    End If
    Row = Row + 1
  Loop
  On Error GoTo 0
End Sub
Sub DummyMacro()
  MsgBox "您可以在本过程中添加相应的操作代码."
End Sub

  换句话说,该技术使用了一个存放在MenuSheet工作表中的表格(如下图2所示),只需按自已的需要简单地修改表中的数据,就可创建自已的菜单。

标签: