Excel 2007基础教程:自定义菜单技术转贴,请高手研究一下供菜菜使用

yuwenjiahui

Excel 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
此外，也可以使用VBA代码在工作表中列出所有的FaceID图像和相对应的整数。该代码由John D. McLean编写，代码清单如下：
'在工作表中显示所有工具栏按钮图像/图标，由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运行上面的代码后，将新建一个工作簿，并在该工作簿内列出所有的内置图标图像，最左列、最右列、最顶部、最底部为相应的数字，将某图标对应的最左(或右)列的数字与最顶一行(或最底一行)的数字相加，即为该图标对应的数字。

　(注：上面的代码运行较慢，需耐心等待。)

[ 本帖最后由 yuwenjiahui 于 2009-5-6 00:36 编辑 ]