2007基础:自定义菜单技术（1）
Excel 2007使用了新的用户界面，每项功能都在称作Ribbon的功能区中且它们的位置都是固定的，仅快速访问工具栏(QAT)与先前版本的工具栏相似，可用来添加或删除命令。因此，在Excel 2007中创建自定义菜单并为菜单项指定宏不像在Excel 2003中那样容易。本文汇总了John Walkenbach、John McLea和Ron de Bruin所介绍的技术。
- - - -技术
—— 识别工具栏图像
如果使用Excel 97或以后的版本，您知道它使用一些图像在它的内置菜单和工具栏中。您能够通过设置FaceID属性为一个特定的整数在自定义菜单和工具栏中使用这些内置图像。然而，问题是如何知道图像所对应的整数。
下面的子过程创建了一个带有开始的250个FaceID图像(见下图1所示)的自定义工具栏。创建了工具栏之后，将鼠标指针放在按钮上面来找到与图像相应的FaceID值。但单击工具栏按钮不会产生任何效果，因为子过程没有在OnAction属性中分配任何宏。当然，您能够通过改变IDStart和IDStop的值来看到更多的图像，最后一个FaceID图像显示数字3518(也有一些空白图像)。
图1：创建一个FaceID工具栏，当鼠标放在某图像上时将显示相应的数字
下面是子过程代码：
Sub ShowFaceIDs()运行上面的代码后，将新建一个工作簿，并在该工作簿内列出所有的内置图标图像，最左列、最右列、最顶部、最底部为相应的数字，将某图标对应的最左(或右)列的数字与最顶一行(或最底一行)的数字相加，即为该图标对应的数字。
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
Dim i As Integer, IDStart As Integer, IDStop As Integer
'如果已存在FaceIds工具栏则删除
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0
'添加一个空工具栏
Set NewToolbar = Application.CommandBars.Add _
(Name:="FaceIds", temporary:=True)
NewToolbar.Visible = True
'可以改变下面的值来看到不同的FaceIDs
IDStart = 1
IDStop = 250
For i = IDStart To IDStop
Set NewButton = NewToolbar.Controls.Add _
(Type:=msoControlButton, ID:=2950)
NewButton.FaceId = i
NewButton.Caption = "FaceID = " & i
Next i
NewToolbar.Width = 600
End Sub
'在工作表中显示所有工具栏按钮图像/图标，由36行100列组成
'对应的最左/右列和最顶/底行中的数字相加即为该图标号
Sub DisplayButtonFacesInGrid()
Const cbName = "JDMTestToolBar"
Dim cBar As CommandBar, cBut As CommandBarControl
Dim r As Long, c As Integer, count As Integer
Application.StatusBar = "Creating Button FaceIDs ......."
Workbooks.Add
'创建四周的数字
For r = 0 To 35
Cells(r + 2, 1).Value = 100 * r: Cells(r + 2, 102).Value = 100 * r
Next r
For c = 0 To 99
Cells(1, c + 2).Value = c: Cells(38, c + 2).Value = c
Next c
Range("A1:A38").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("CX1:CX38").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("B1:CW1").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("B38:CW38").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("E5").Select
Selection.Value = "Please wait .............."
With Selection.Font
.Name = "Arial"
.Size = 24
.Bold = True
.ColorIndex = 3
End With
Range("E5:J10").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
Application.ScreenUpdating = False
With Selection
.ClearContents
.UnMerge
End With
On Error Resume Next
CommandBars(cbName).Delete
On Error GoTo 0
Set cBar = CommandBars.Add '创建带有一个按钮的临时工具栏
With cBar
.Name = cbName
.Top = 0
.Left = 0
.Visible = True
End With
r = 2: c = 2: count = 0 '在单元格Cell(2,2)中的FaceID号为0
Set cBut = CommandBars(cbName).Controls.Add(Type:=msoControlButton)
With cBut
Do '循环所有的FaceIDs
.FaceId = count
Cells(r, c).Select '分配至按钮然后复制到工作表
.CopyFace
Selection.PasteSpecial
Cells(1, 1).Copy
c = c + 1
If c >= 102 Then '更新复制的位置
c = 2
r = r + 1
End If
count = count + 1
Loop While count < 3519 '3519是最大的FaceID号
End With
Rows("1:38").RowHeight = 24.6 '增大单元格尺寸
Columns("A:CX").ColumnWidth = 5.56
With ActiveSheet.DrawingObjects '增大按钮尺寸
.ShapeRange.ScaleWidth 2#, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 2#, msoFalse, msoScaleFromTopLeft
.ShapeRange.IncrementLeft 8.4
.ShapeRange.IncrementTop 3#
End With
Range(Cells(2, 2), Cells(37, 101)).Select '格式化网格线和背景
With Selection
With .Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
End With
'恢复Excel设置
CommandBars(cbName).Delete
On Error GoTo 0
Range("A1").Select
Application.ScreenUpdating = True
Application.StatusBar = ""
End Sub
(注：上面的代码运行较慢，需耐心等待。)