第3个回答 2009-02-17
自定义右键菜单
前面说过了自定义菜单与工具栏，如果大家利用好了，就可以很方便地让别人使用你编辑好的，功能了。而这一贴要讲的，利用右键的菜单，让调用功能更为方便。
当我们使用右键时，Excel相对应都会有一些功能在右键的菜单中出现，比如右击单元格时有设定单元格的功能，右击行号与列标时，有设定行高与列宽的功能，那么，我们也可以相应在我们需要的时候，将功能将入右键的菜单中，方便调用，比如下面说的自定义宏——合并复制选择单元格的内容，即可以加入到在右击单元格时产生的右键菜单中。
其实这些菜单的使用方法和前面将的菜单与工具栏是类似的，工具栏对应的是CommandBars对象，菜单对应的是CommandBarControl对象，而CommandBarControl 对象中又分有三种——ComandBarButton(按钮控件)、CommandBarComboBox(组合框控件)以及这贴说的CommandBarPopup（弹出式控件），下面给出一段程序，在表格中列出全部的弹出式控件的名称及项目等内容。
Sub ListPopups()
Dim ctl As CommandBarControl
Dim cb As CommandBar
Dim intRow As Integer 'Tracks row in worksheet
'下面一行是检查当前工作表是否没有内容
If Not IsEmptyWorksheet(ActiveSheet) Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
Cells(1, 1).Value = "CommandBar"
Cells(1, 2).Value = "Control"
Cells(1, 3).Value = "FaceID"
Cells(1, 4).Value = "ID"
Range("A1:D1").Font.Bold = True
intRow = 2
For Each cb In CommandBars
Application.StatusBar = "正在处理控制... " & cb.Name
'Only list command bar if type is Popup
If cb.Type = msoBarTypePopup Then
Cells(intRow, 1).Value = cb.Name
intRow = intRow + 1
'List controls on command bar
For Each ctl In cb.Controls
Cells(intRow, 2).Value = ctl.Caption
ctl.CopyFace
If Err.Number = 0 Then
ActiveSheet.Paste Cells(intRow, 3)
Cells(intRow, 3).Value = ctl.FaceId
End If
Cells(intRow, 4).Value = ctl.Id
Err.Clear
intRow = intRow + 1
Next ctl
End If
Next cb
Range("A:B").EntireColumn.AutoFit
Application.StatusBar = False
End Sub
'检查当前工作表是否有内容的函数
Function IsEmptyWorksheet(sht As Object) As Boolean
If TypeName(sht) = "Worksheet" Then
If WorksheetFunction.CountA(sht.UsedRange) = 0 Then
IsEmptyWorksheet = True
Exit Function
End If
End If
MsgBox "请生成一个空的工作表！", vbCritical, _
"Warning"
End Function
从上面的程序可以让我们了解各种情况下的弹出菜单，只要通过名称及其相应的功能，我们就可以和现实中的操作对比，来获得需要的弹出菜单名称，比如单元格——Cell，行——Row等。之后我们就可以将自定义的项目加入对应的菜单中了。以下是我现实合并复复增减菜单项目的代码，其余代码略过：
Sub Menu_Del()
Dim N
N = Application.CommandBars("Cell").Controls.Count
For I = 1 To N
'当发现右键菜单中有"合并复制(&A)"项时将其删除
If Application.CommandBars("Cell").Controls(I).Caption = "合并复制(&A)" Then
Application.CommandBars("Cell").Controls(I).Delete
'下面这句是重置菜单，但个人认为还是用上面的方法比较好
'Application.CommandBars("cell").Reset
End If
Next
End Sub
Sub Menu_Add()
Dim N, I, Cmb As CommandBarControl
N = Application.CommandBars("Cell").Controls.Count
For I = 1 To N
If Application.CommandBars("Cell").Controls(I).Caption = "合并复制(&A)" Then
Exit Sub
End If
Next
Set Cmb = Application.CommandBars("cell").Controls.Add(Type:=msoControlButton)
With Cmb
.BeginGroup = True
.Caption = "合并复制(&A)"
.OnAction = "UnionCopy"
.FaceId = 159
End With
End Sub
以上两个程序的实例，请到我本站中的自定义宏项里下载——内置菜单与合并复制。
到此贴，自定义的内容已基本完成，而下面的自定义功能只是让大家多感受一些编程的魅力——只有想不到，没有做不到，而下面的功能的具体实现方法我也不是能给大家解释得很清楚，因为大多是基于类模块与API的应用，我也只能将相关的原代码贴出来，与大家分享！
自定义快捷键
前面我们已说明的怎么我们的加载宏自动生成一些菜单来调用我们编辑的功能，而接下来，我们还要进一步添加一个功能，即用快捷键来调用宏。
用来Excel的朋友都或多或少使用过快捷键吧，比如保存Ctrl+S，那怎么给我们的宏也加上快捷键呢，其实也很简单，只要在文件打开是用Application.OnKey定义我们的快捷键即可，下面是OnKey方法在Excel帮助中的内容：
当按特定键或特定的组合键时运行指定的过程。
expression.OnKey(Key, Procedure)
expression 必需。该表达式返回一个 Application 对象。
Key String 类型，必需。用于表示要按的键的字符串。
Procedure Variant 类型，可选。表示要运行的过程名称的字符串。如果 Procedure 参数为空文本 ("")，则按 Key 时不发生任何操作。OnKey 方式将更改击键在 Microsoft Excel 中产生的正常结果。如果省略 Procedure 参数，则 Key 产生 Microsoft Excel 中的正常结果，同时清除先前使用 OnKey 方法所做的特殊击键设置。
说明
Key 参数可指定任何与 Alt、Ctrl 或 Shift 组合使用的键，还可以指定这些键的任何组合。每一个键可由一个或多个字符表示，比如 "a" 表示字符 a，或者 "{ENTER}" 表示 Enter。
若要指定按对应的键（例如 Enter 或 Tab）时的非显示字符，请使用下表所列出的代码。表中的每一代码代表键盘上的一个对应键。
键 代码
{BACKSPACE} or {BS}——Backspace
{BREAK}——Break
Caps Lock——{CAPSLOCK}
{CLEAR}——Clear
Delete 或 Del——{DELETE} 或 {DEL}
End——{END}
~（波形符）——Enter
Enter（数字小键盘）——{ENTER}
{ESCAPE} 或 {ESC}——Esc
{F1} 到 {F15}——F1 到 F15
{HELP}——Help
Home——{HOME}
{INSERT}——Ins
Num Lock——{NUMLOCK}
Page Down——{PGDN}
{PGUP}——Page Up
{RETURN}——Return
{SCROLLLOCK}——Scroll Lock
Tab——{TAB}
向上键——{UP}
{DOWN}——向下键
{RIGHT}——向右键
向左键——{LEFT}
还可指定与 Shift 和/或 Ctrl 和/或 Alt 组合使用的键。若要指定与其他键组合使用的键，可使用下表。
要组合的键 在键代码之前添加
Shift——+（加号）
Ctrl——^（插入符号）
Alt——%（百分号）
若为特定字符指定处理过程（如 +、^、% 等等），可将此字符用圆括号括起。有关详细信息，请参阅示例。
示例
本示例为 Ctrl+ 加号分配“InsertProc”过程，并为 Shift+Ctrl+ 向右键分配“SpecialPrintProc”过程。
Application.OnKey "^{+}", "InsertProc"
Application.OnKey "+^{RIGHT}", "SpecialPrintProc"
本示例将 Shift+Ctrl+ 向右键重新设为正常的含义。
Application.OnKey "+^{RIGHT}"
本示例将 Shift+Ctrl+ 向右键设为不发生任何操作。
Application.OnKey "+^{RIGHT}", ""
这样，我们调用宏是不是又方便了不少，还有，要注意的一点是，在关闭加载宏时，要记得将快捷键还原哦。
VBA之类模块
说真的，类和类模块我也是接触得不多，不久，应用也很少，对这方面的了解也很少，这里只能将我所理解的这一点点，和大家一请交流：
什么是类：将用户定义类型和过程组织在一起即是类，类是一个模板，对象是由它而创建的。
什么是类模块：含有类定义的模块，包括其属性和方法的定义。
怎么建立类模块：建立类模块的方法和建立模块的方法是一样的，只是选择建立的项目是类模块。
上面就是现在我对类模块的了解，不多，甚至自己也有很多不理解的地方，在类模块的使用方面，记忆里曾经在学VB时编一个贪吃小蛇时，用过类来实现队列（先进先出的一种数据结构），之后就仅仅用类创建一个Application 对象来即时监控Excel，下面就将这个应用的代码列给大家。
还记得在自定义菜单中定义的名为“Excel各页名”的宏吧，当没有可见的工作簿时，如果运行此宏就会出错，因为无法写入内容。上贴我们已给这个宏加入了快捷键的功能，使它更方便的使用，而这一贴我们就要利用类模块，让它更完美。
其实只要在这个宏的代码里加入检验的代码，即可以不会出错，但实际，我们还是运行了这个宏。细心的朋友有没有发现，当Excel无可见工作簿时，一些工具栏和菜单里的项目是不可使用的，那我们今天也来实现这个功能。
首先要建立一个类模块，名为MenuClass，注意，这个名称对应着后面的代码，如果改动的话，后面也需要进行相应的修改，类模块的代码如下：
'定义一个 Application 对象
Public WithEvents xlApp As Excel.Application
'定义一个按钮控件属性，用来对应相应的菜单项
Public XMenu As CommandBarButton
'定义一个字符串，用来保存相应的快捷键
Public XOnkey As String
'定义一个字符串，用来保存相应的宏名称
Public XSubName As String
'当文件新建打开关闭隐藏时都有可能使可见的工作簿数量变动
'但我们只要监控WorkbookActivate（激活任一工作簿）事件与
'WorkbookDeactivate（工作簿由活动转为非活动状态）事件即可。
'下面即是相对应的代码：
Private Sub xlApp_WorkbookActivate(ByVal Wb As Workbook)
If XMenu Is Nothing Then
Exit Sub
End If
If Wb.Windows(1).Visible Then
XMenu.Enabled = True
Application.Onkey XOnkey, XSubName
End If
End Sub
Private Sub xlApp_WorkbookDeactivate(ByVal Wb As Workbook)
Dim XWindow As Window
If XMenu Is Nothing Then
Exit Sub
End If
For Each XWindow In xlApp.Windows
If XWindow.Caption <> Wb.Name And XWindow.Visible Then
XMenu.Enabled = True
Application.Onkey XOnkey, XSubName
Exit Sub
End If
Next
XMenu.Enabled = False
Application.Onkey XOnkey
End Sub
完成类模块的代码后，我们即可以使用这个类。下面是在mian模块中的一些相应的代码：
'定义一个我们自定义的类
Dim EMenu As New MenuClass
Dim AName, MName(2, 1), DelMenu(2) As Boolean
Sub auto_close()
Dim MyMenu As CommandBarPopup
Dim MyBtn As CommandBarButton
Dim i As Byte
Application.Onkey "^%a"
Set EMenu.XMenu = Nothing
Set MyMenu = CommandBars("Worksheet Menu Bar").Controls(AName)
For i = 0 To UBound(MName)
If DelMenu(i) Then
Set MyBtn = MyMenu.CommandBar.Controls(MName(i, 0))
If MyBtn Is Nothing Then
Error = True
Else
MyBtn.Delete
End If
End If
Next
If MyMenu.CommandBar.Controls.Count = 0 Then
MyMenu.Delete
Else
For i = 1 To MyMenu.CommandBar.Controls.Count
Set MyBtn = MyMenu.Controls(i)
MyBtn.FaceId = MyBtn.Index + 79
Next
End If
If Err.Number > 0 Then
MsgBox "文件关闭时卸载菜单发生异常！" & vbCrLf & _
"自动生成的菜单可能已被卸载！" & vbCrLf & _
"或生成的菜单没有完全被卸载！", vbExclamation, "错误"
End If
End Sub
Sub auto_Open()
Dim MyMenu As CommandBarPopup
Dim MyBtn As CommandBarButton
Dim i As Byte
Dim XT As String
On Error Resume Next
AName = "自定义(&Z)" '菜单名称
MName(0, 0) = "百度Excel吧(&A)" '菜单项名称
MName(0, 1) = "BaiDuExcelBa" '指定宏名称
MName(1, 0) = "Excel吧主页(&B)" '菜单项名称
MName(1, 1) = "ExcelBaZy" '指定宏名称
MName(2, 0) = "Excel各页名(&C)" '菜单项名称
MName(2, 1) = "Excel各页名" '指定宏名称
Set MyMenu = CommandBars("Worksheet Menu Bar").Controls(AName)
If MyMenu Is Nothing Then
Set MyMenu = CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup)
MyMenu.Caption = AName
End If
For i = 0 To UBound(MName)
Set MyBtn = MyMenu.CommandBar.Controls(MName(i, 0))
If MyBtn Is Nothing Then
DelMenu(i) = True
Set MyBtn = MyMenu.CommandBar.Controls.Add(Type:=msoControlButton)
With MyBtn
.Style = msoButtonIconAndCaption
.FaceId = 79 + MyBtn.Index
.Caption = MName(i, 0)
.OnAction = MName(i, 1)
End With
Else
DelMenu(i) = False
XT = XT & vbCrLf & MName(i, 0)
End If
Set MyBtn = Nothing
Next
'初始化相关的属性
Set EMenu.XMenu = MyMenu.CommandBar.Controls(3)
EMenu.XMenu.Enabled = False
For Each XWindow In Application.Windows
If XWindow.Visible Then
EMenu.XMenu.Enabled = True
Exit For
End If
Next
Set EMenu.xlApp = Application
EMenu.XOnkey = "^%a"
EMenu.XSubName = "Excel各页名"
Application.Onkey EMenu.XOnkey, EMenu.XSubName
If Len(XT) > 0 Then
MsgBox "已存在菜单名：" & XT & vbCrLf & "不能再被加载！", vbExclamation, "错误"
End If
End Sub
也许大家看完了之后还不是很了解，但我能力也有限，目前只能给大家解释到此，等以后对此有更深的理解之后，还会和大家一起分享。大家可以从本站里下载完整的代码——自定义宏/Excel各页名本回答被网友采纳