日常使用 Microsoft Office 的过程中，对于这一强大办公软件自带的功能我们直接使用即可，而对于一些软件默认没有，后期我们通过录制宏或者 VBA 实现的一些符合自己实际使用情况的小功能，每次使用都重新录制宏或者敲 VBA 代码显然比较麻烦，这时候我们往往希望将这些自定义的小功能变成类似 Office 功能区的各个小功能一样直接使用，这样将极大的提高我们的工作效率， customUI 可以帮助我们实现此类需求。
由于 Office 2007 版本后，用户操作界面有了极大的改变，原有的菜单栏、工具栏被功能区、选项卡所取代，且就目前来看使用 Office 2007 之前版本的用户几乎没有多少了，所以本文对 Office 2003 及其版本的修改方式不做讨论。由于博主所学有限，这里以 Excel 2010 为例，仅对实现方式做简要概述。
新建启用宏的工作簿（xlsm）
打开 Excel 2010 软件，新建一个名为“蝈蝈小工具”的工作簿并另存为启用宏的工作簿。将该工作部保存到桌面“Excel 自定义选项卡”文件夹下。
PS：这里的文件名及文件夹名根据实际情况修改亦可。
构建 customUI.xml 文件
新建一个名为 customUI.xml 的文件，并在该文件中粘贴如下代码即可。代码中 tab 标签定义选项卡、group 定义功能分组、control 与 button 定义按钮控件，更多标签你可以查阅官方文档。
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="rxtabCustom" label="Excel小工具" insertBeforeMso="TabHome">
<group id="mygroupA" label="常规选项">
<control idMso="FileSave" size="large" label="保存文档 " />
<control idMso="FileSaveAs" size="large" label="导出文档 " />
<control idMso="FilePrint" size="large" label="打印文档 " />
<control idMso="FilePrintPreview" size="large" label="打印预览 " />
</group>
<group id="mygroupB" label="行列操作">
<button id="qggUpTableRows" imageMso="TableRowsInsertAboveWord" size="large" label="向上移动 " onAction="qggUpTableRows"/>
<button id="qggDownTableRows" imageMso="TableRowsInsertBelowWord" size="large" label="向下移动 " onAction="qggDownTableRows"/>
<button id="qggScreenshot" imageMso="PictureCrop" size="large" label="数据截图 " onAction="qggScreenshot"/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
注意代码中的按钮控件将会在之后的 Excel 选项卡中出现。
.rels 文件中引入 customUI.xml
将上面新建的“蝈蝈小工具.xlsm”文件重命名为“蝈蝈小工具.xlsm.zip”，使用压缩软件打开，找到 _rels 文件夹下的 .rels 文件，在该文件的最后一个</Relationships>之前添加如下代码：
<Relationship Id="customUIRelID" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/>
关于 .rels 文件，你可以查看我之前发布的文字>>> Excel~文件结构初窥 。
使用修改后的 .rels 文件替换掉原文件，然后将上一步中的 customUI.xml 放在customUI 文件夹下丢到压缩文件根目录下。
全部修改替换后压缩包下文档结构大致如下：
另存为加载宏的工作簿（xlam）
还原“蝈蝈小工具.xlsm.zip”文件名为“蝈蝈小工具.xlsm”使用 Excel 2010 软件打开，可以看到已经加载出了选项卡信息，大致如下：
然而我们点击按钮并不能运行相关功能，进入 VBE 编辑器，插入一个模块，在模块中添加如下代码，并另存为“蝈蝈小工具.xlam”文件即可实现功能。
Option Explicit
Public numBeginRows, numBeginColumns, numEndRows, numEndColumns As Integer
Function UsedRangeParameter()
numBeginRows = ActiveSheet.UsedRange.Cells(1, 1).Row '获取当前已用表格区域的初始行位置
numBeginColumns = ActiveSheet.UsedRange.Cells(1, 1).Column '获取当前已用表格区域的初始列位置
numEndRows = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1 '获取当前已用表格区域的末尾行位置
numEndColumns = ActiveSheet.UsedRange.Columns.Count + ActiveSheet.UsedRange.Column - 1 '获取当前已用表格区域的末尾列位置
End Function
'向上移动
Sub qggUpTableRows(control As IRibbonControl)
On Error Resume Next
Dim i, j, numselectedRows As Integer
i = Selection.Row '获取当前选中单元格的行位置
j = Selection.Column '获取当前选中单元格的列位置
numselectedRows = Selection.Rows.Count '获取当前选中的行数
Call UsedRangeParameter
If i < numBeginRows Or i > numEndRows Or j < numBeginColumns Or j > numEndColumns Then Exit Sub '目标区域不在已用表格区域内时跳出过程
'选中的单元格区域向上移动
Range(Cells(i, numBeginColumns), Cells((numselectedRows - 1) + i, numEndColumns)).Select
Selection.Cut
Selection.Offset(-1, 0).Insert
Selection.Offset(-1, 0).Select
End Sub
'向下移动
Sub qggDownTableRows(control As IRibbonControl)
On Error Resume Next
Dim i, j, numselectedRows As Integer
i = Selection.Row '获取当前选中单元格的行位置
j = Selection.Column '获取当前选中单元格的列位置
numselectedRows = Selection.Rows.Count '获取当前选中的行数
Call UsedRangeParameter
If i < numBeginRows Or i > numEndRows Or j < numBeginColumns Or j > numEndColumns Then Exit Sub '目标区域不在已用表格区域内时跳出过程
'选中的单元格区域向下移动
Range(Cells(i, numBeginColumns), Cells(i + (numselectedRows - 1), numEndColumns)).Select
Selection.Cut
Selection.Offset(numselectedRows + 1, 0).Insert
Selection.Offset(1, 0).Select
End Sub
Sub qggScreenshot(control As IRibbonControl)
On Error Resume Next
Dim rngScreenshot As Range, iShape As Shape, picName As String, myFolder As String, selectFolder As String, imgFileFilter As String
Call UsedRangeParameter
Set rngScreenshot = Range(Cells(numBeginRows, numBeginColumns), Cells(numEndRows, numEndColumns))
picName = "qgg-" & Replace(Replace(rngScreenshot.Address, "$", ""), ":", "") & "-" & Format(Date, "yyyymmdd")
'myFolder = ThisWorkbook.Path & "\Screenshot\" '指定文件夹名称
imgFileFilter = "JPEG 格式图片(*.jpg),*.jpg," & "PNG 格式图片(*.png),*.png," & "BMP 格式文件(*.bmp),*.bmp," & "GIF 格式图片(*.gif),*.gif,"
selectFolder = Application.GetSaveAsFilename(InitialFileName:=picName, FileFilter:=imgFileFilter, Title:="图片另存为")
rngScreenshot.Copy
ActiveSheet.Pictures.Paste.Select
Selection.ShapeRange.Name = picName
'遍历 Shape 元素，找到截图图片
For Each iShape In ActiveSheet.Shapes
If iShape.Name = picName Then
'If Len(Dir(myFolder, vbDirectory)) = 0 Then MkDir myFolder
iShape.CopyPicture
With ActiveSheet.ChartObjects.Add(0, 0, iShape.Width, iShape.Height).Chart
.Parent.Select '选择父对象 ChartOjbect ，确保真正的粘贴上
.Paste
'.Export myFolder & picName & ".jpg", "JPG"
.Export selectFolder
.Parent.Delete
End With
iShape.Delete
End If
Next iShape
If selectFolder <> False Then MsgBox ("数据截图已保存到指定文件夹下！！！")
End Sub
双击打开“蝈蝈小工具.xlam”文件即可在 Excel “开始”选项卡前面看到一个新插入的选项卡及其功能。如下图所示：
安装与卸载
使用上述方式制作的加载宏文件（xlam）只有在双击打开时才会运行，如果你想实现自动安装及卸载插件可分别新建两个名为“蝈蝈小工具_安装.xlsm”与“蝈蝈小工具_卸载.xlsm”的文件，并分别在 VBE 编辑器 ThisWorkbook 模块中插入如下两端代码即可。
'安装“蝈蝈小工具”代码
Private Sub Workbook_Open()
AddIns.Add Filename:=ThisWorkbook.Path & "\蝈蝈小工具.xlam"
Application.AddIns("蝈蝈小工具").Installed = 1
End Sub
'卸载“蝈蝈小工具”代码
Private Sub Workbook_Open()
On Error Resume Next
AddIns("蝈蝈小工具").Installed = False
End Sub
注意上述代码中的路径此处获取的是当前工作簿下的对应路径，你也可以修改为其他路径。
文档参考：
评论 抢沙发