标签：VBA，用户界面
本文接上篇文章：
在Excel中自定义上下文菜单（上）
使用RibbonX将控件添加到单元格上下文菜单
在下面的示例中，将创建与上文描述的示例相同的按钮和子菜单，但使用RibbonX创建。
1.打开一个新工作簿，将其保存为启用宏的工作簿（.xlsm）。
2.关闭该工作簿。
3.在Custom UI Editor中打开这个工作簿。
4.单击菜单“插入——Office 2010 定制UI”。
5.在Custom UI Editor中输入下面的XML：
代码语言：javascript复制<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<contextMenus>
<contextMenu idMso="ContextMenuCell">
<button idMso="FileSave" insertBeforeMso="Cut" />
<button id="MyButton" label="切换大写/小写/合适"
insertBeforeMso="Cut"
onAction="ToggleCaseMacro"
imageMso="HappyFace"/>
<menu id="MySubMenu" label="大小写转换菜单" insertBeforeMso="Cut" >
<button id="Menu1Button1" label="大写"
imageMso="U" onAction="UpperMacro"/>
<button id="Menu1Button2" label="小写"
imageMso="L" onAction="LowerMacro"/>
<button id="Menu1Button3" label="合适的大小写"
imageMso="P" onAction="ProperMacro"/>
</menu>
<menuSeparator id="MySeparator" insertBeforeMso="Cut" />
</contextMenu>
</contextMenus>
</customUI>如下图3所示。
图3
6.保存并关闭编辑器。
7.在Excel中打开该工作簿。
8.在VBE的标准模块中粘贴或输入下面的代码：
代码语言：javascript复制Sub ToggleCaseMacro(control As IRibbonControl)
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange
Select Case cell.Value
Case UCase(cell.Value): cell.Value = LCase(cell.Value)
Case LCase(cell.Value): cell.Value = StrConv(cell.Value, vbProperCase)
Case Else: cell.Value = UCase(cell.Value)
End Select
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Sub UpperMacro(control As IRibbonControl)
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange
cell.Value = UCase(cell.Value)
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Sub LowerMacro(control As IRibbonControl)
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange
cell.Value = LCase(cell.Value)
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Sub ProperMacro(control As IRibbonControl)
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange
cell.Value = StrConv(cell.Value, vbProperCase)
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub9.在该工作簿中，右键单击包含文本的单元格，查看单元格上下文菜单是否已更改。
10.选择该上下文菜单中添加的自定义选项，查看其对单元格文本的影响。
要使用内置命令添加自定义按钮，将语句：
<button idMso=”FileSave” insertBeforeMso=”Cut” />
替换为下面的语句：
<button id=”DuplicateBuiltInButton1” label=”Save” insertBeforeMso=”Cut” onAction=”BuiltInSaveCommand” imageMso=”FileSave” />
接下来，在VBE中，添加由onAction属性调用的宏。
代码语言：javascript复制Sub BuiltInSaveCommand(control As IRibbonControl)
CommandBars.ExecuteMso "FileSave"
End Sub此外，还可以使用ActiveWorkbook.Save方法。然而，通过使用ExecuteMso方法，可以在Microsoft Office Fluent UI上执行任何内置控件。
使用VBA代码或RibbonX将动态菜单添加到单元格上下文菜单
动态菜单指向在运行时创建菜单的回调过程。dynamicMenu控件包含指向GetContent回调过程的getContent属性。
下面是在单元格上下文菜单中创建动态菜单的RibbonX XML。
代码语言：javascript复制<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<contextMenus>
<contextMenu idMso="ContextMenuCell">
<dynamicMenu id="MyDynamicMenu"
label= "我的动态菜单" imageMso="HappyFace"
getContent="GetContent" insertBeforeMso="Cut"/>
</contextMenu>
</contextMenus>
</customUI>如下图4所示。
图4
例如，下面的VBA代码在运行时使用两个按钮构建动态菜单，这意味着只有单击上下文菜单上的菜单控件才能创建动态菜单。
代码语言：javascript复制Sub GetContent(control As IRibbonControl, ByRef returnedVal)
Dim xml As String
xml = "<menu http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<button id=""but1"" imageMso=""Help"" label=""帮助"" onAction=""HelpMacro""/>" & _
"<button id=""but2"" imageMso=""FindDialog"" label=""查找"" onAction=""FindMacro""/>" & _
"</menu>"
returnedVal = xml
End Sub
Sub HelpMacro(control As IRibbonControl)
MsgBox "Help macro"
End Sub
Sub FindMacro(control As IRibbonControl)
MsgBox "Find macro"
End Sub
