标签：文件插件 End 代码 vba xlam 手册 getCond

大家来和笔者一起做一个xlam插件吧。很简单，很详细。

楔子

excel支持自定义菜单栏，但是我在搜索如何制作菜单栏，以及如何制作addin文件的时候，即使是最好的例子，也只是点到为止，做了一个按钮就结束了。想要再进一步，竟然就没有合适的二手资料了。所以自然笔者就决定自己补充这样一篇文章。并且以实验手册的形式，并且把自己的方法论也一并分享出来。

方法论

清单
写代码的时候，笔者一般是先写草稿和注释。然后把后续的一些困难也列进清单中。
清单的作用一个是因为如果是比较基础的工具，工程规模不大，很可能是自己一个人完成的任务，但是没有一件事情是一条直线走到底的。所以为了执行，需要把任务扁平化，即使不能从最优的顺序去执行，也不至于在执行的时候，被自己的其他思路干扰。而且困难可以暂时放着，甚至到后面选择其他的方案。
单元测试
由于excel的vba工程，既包含了界面，又包含代码，而且vba语言不是我们的主要工作代码，所以代码出现错误是很正常的。但是也没必要去写测试代码，根据笔者自己简单有用4个字的原则，是边写边测，测过的代码就认为是没问题的。调试起来bug也很少，能够很快定位问题，bug一般在新写出来的代码中。这样就不需要到处找bug，也不会不知道用什么测试用例来寻找bug。每一段新写的代码就代表一个用例，这样写出来的代码，从结构上来说也方便维护，不太需要大幅的重构。
为什么需要方法论
做这样的一次性的付出就可以得到成果的工作，过程和结果都是未知的。和重复劳动对应的稳定相比，哪个可以带来快乐，哪个带来焦虑。取决于知识和方法，零散的知识能支撑方法。实际还是要在实践中采用正确的方法，得到未知的成果。

前提

基础知识

excel数据结构
- vba的学习，直接看别人的代码和例子是不够的。因为数据结构操作和vba语法混杂在一起，会让人误认为，这就是vba。
  excel的数据结构也是非常的简单，Application -> Workbook -> WorkSheet -> Range，这样的4层结构。所有要把这个数据结构操作的代码刨除出去，才是vba原来的语法的样子。所以说对这些数据结构对应的类的操作的代码和vba的其他代码需要分开来看和理解学习。
- aplication这个概念就相当于一个启动的excel的进程。然后还有一些对象，其实都属于application的下面的，比如Selection，ActiveSheet, ActiveWorkbook, ActiveWindow，方便我们和界面进行互动。

excel应用安装

必须是安装了excel，wps不能进行实验。

需求

由于excel并不提供对文本框图形中的文字进行检索，（可能是因为其他种类的对象比如图片等，类型太多了，没有办法全部开发出来，干脆就不开发了。）所以就总感觉，我搜索关键字的时候，文本框里的内容搜不到，
本来文本框可以自由的进行一些标注和说明的，搜索不到，只能靠肉眼找非常累，降低效率成为了阅读文档的阻碍。
（实际上，笔者后面在开发的时候也遇到了一些问题，比如图形还分为group对象，或者隐藏对象，或者是没有文字的，没有完全统一的数据结构，搜索的时候直接报错，或者搜索到了不存在的东西，通过笔者的一些If判断代码，也成功的回避了这个问题）

实验步骤

步骤概要

生成一个带有菜单栏的xlsm文件（主要是编辑xlsm文件中的custom/customUI.xml的内容）
把xlsm文件另存为xlam，并加载进来。
开发xlam的vba的代码
（如果需要重新调整菜单栏的项目，取消xlam的加载，把xlam作为zip文件解压，重新修改菜单栏内容后，再次压缩成zip文件，修改文件后缀为xlam，重新加载xlam）

customUI.xml制作菜单栏界面

由于有手工编写代码的部分，笔者直接找了xlwings.xlam拿过来作为模版，这个在github/xlwings/xlwings中有。见本文【参考链接】
- 第二种方法是自定义菜单栏，然后导出自定义的ribbon，结果笔者的电脑系统是mac系统，只能自定义，但是不能导出。所以还是决定用xlwings.xlam作为模版，拷贝过来。内容都是一样的，殊途同归。
- 第三种方法是比较正式的方法，是下载customUIeditor, 先创建一个xlam或者xlsm文件，然后用这个editor打开，然后在里面先生成一个模版。然后编辑xml，然后保存，然后把这个xlam加载进来，菜单栏就出现了。然后开始开发vba代码。
  （但是这个editor是exe的，算了，而且模版的内容过于简单，没有xlwings模版丰富。这可能也是导致别人的文章里面只有一个按钮就点到为止的原因。因为editor里面的模版就一个笑脸按钮，一个按钮真的，等于没有用。但是编辑customUI.xml不用每次解压和压缩文件了）
  下载链接见本文【参考链接】
首先生成一个新的xlsm文件，然后修改名称，从【图形检索.xlsm】，改为【图形检索.zip】，然后解压成文件夹
解压后的目录结构如下（, 注意如果是在mac中，解压工具里面的配置是不是有隐藏文件不解压的设置，需要把所有内容完整的解压出来。笔者直接用自带工具解压失败。用其他压缩工具能够解压。）

- rel
	- .rels
- docProps
- xl
- [Content_Types].xml

（稍后，在后面的步骤之后，需要重新把这个文件夹压缩成zip，然后修改文件后缀为xlsm，然后打开，看看是不是能够正常打开。）（笔者的文件打开后有修复信息，然后重新保存了一下）
然后我们把下载好的xlwings.xlam文件也是修改后缀为zip,解压开来，解压后的文件结构是这样的。

- rel
	- .rels
- customUI
	- customUI.xml
- docProps
- xl
- [Content_Types].xml

对我们有用的是.rels 和customUI.xml。（如果看不见隐藏文件.rels，mac系统请按shift + command + . 来显示隐藏文件。)
我们打开.rels和customUI.xml （这里如果没有下载好xlwings.xlam文件也没有关系，因为我会给出所有需要的代码）
- 在.rels文件中添加一个relationship元素 <Relationship Id="customUItuxingjiansuo" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/>
- 整个文件长这样

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">
<Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/>
<Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/>
<Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>
<Relationship Id="customUItuxingjiansuo" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/>
</Relationships>

然后我们按照.rels文件中的customUI/customUI.xml的配置，创建一个文件夹customUI和文件customUI.xml。文件内容如下

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
	<ribbon startFromScratch="false">
		<tabs>
			<tab id="tuxingjiansuo" label="图形检索">
				<group id="udfGroup" label="检索">
					<editBox id="keyword" label="关键字(key1;key2;key3)" onChange="setKeywords" sizeString="AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" screentip="多个关键字用分号; 隔开。匹配方式为*?，非正则表达式匹配"/>
					<button id="search" label="检索" imageMso="MacroPlay" size="large" onAction="searchShapeWithKeywordstuxingjiansuo" screentip="开始检索下一个，只能按顺序往后检索"/>
					<checkBox id="book" label="检索范围：工作簿" onAction="pressBook" screentip="默认检索当前工作表"/>
					<checkBox id="entire" label="完整匹配（开头到结尾" onAction="pressEntire" screentip="每一个关键字需要完整匹配，而不是包含关系"/>
					<checkBox id="col" label="滚动到列" onAction="pressScrollToCol" screentip="检索匹配到之后默认会跳转到图形的行"/>
					<checkBox id="case" label="大小写敏感" onAction="pressCaseSensitive" screentip="默认大小写不敏感"/>
					<checkBox id="nextReverse" label="上一个" onAction="pressPrevious" screentip="检索当前结果的上一个"/>
				</group>
			</tab>
		</tabs>
	</ribbon>
</customUI>

这样我们就完成了菜单栏的编辑，这里提一下，如果是2010版本，.rels文件中添加的是<Relationship Id="customUItuxingjiansuo" Type="http://schemas.microsoft.com/office/2007/relationships/ui/extensibility" Target="customUI/customUI14.xml"/>
- customUI14.xml文件中的开头用 <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
- 这里做这个实验，这两个版本都是可以的，没有什么影响。只是因为xlwings.xlam用的是旧版，所以直接拷贝过来，避免出错排查问题。因为重点是先看一下自己定义的菜单栏是否能正常显示。
然后我们把所有的文件重新压缩成zip包，修改文件名称后缀为xlsm。打开文件，查看菜单栏是否已经正常显示。
如果菜单栏【图形检索】可以正常显示了。那么我们的菜单栏界面做完了。那么接下来可以开发vba的代码。
- 有两个选择，一个是继续在xlsm上面继续开发，那么这个菜单栏和代码都是专属于这个文件的，可以在这个xlsm文件里面测试功能。
- 另一个选择就是直接做成xlam文件，然后作为addin加载进来，vba代码依然在原来的xlam文件对应的vba工程中编辑，但是功能是在其他excel中进行测试。由于我们开发的这个功能是搜索图形，一定是搜索的是每一个打开的excel文件自己的图形包含的文本关键字，可以一步到位，另存为xlam文件，然后加载插件，因为插件的代码其实是可以在加载之后随时修改。
- 这里提示一下。xlam加载文件需要放到一个比较稳定的文件目录下，因为文件一旦删除或者移动，下次打开excel，就会加载失败。

另存为xlam

另存为的方法不是直接修改文件名称后缀的方法了。需要先打开xlsm文件，然后点击另存为，选择xlam格式，然后保存在一个长期稳定的文件夹下。
然后我们把原来的xlsm文件关闭之后，打开另外一个新建的excel文件，这个时候菜单栏【图形检索】就不见了。然后把这个xlam文件加载进来。比如我这里的文件名为图形检索v1.01.xlam。加载方法如下。
- 点击工具 -> excel加载项，然后点击浏览，打开文件图形检索v1.01.xlam 并且显示已经勾选上了。
- 然后我们看一下，菜单栏【图形检索】重新出现了。那么就完成了本小结的步骤。然后进入下一节的vba代码开发。

vba代码开发

现在我们打开着一个普通的xlsx文件，菜单栏【图形检索】已经显示了。需要开发加载项xlam文件的功能，我们首先进入vba工程界面
- 按下 alt + F11 （如果您的笔记本的F11功能键，需要按下Fn + F11才能生效。那么您需要按下 alt + Fn + F11)
然后我们看到了我们的xlam文件，右键插入模块。然后把下面的【模块1】代码复制进去
然后再创建一个类模块，修改类的名称为CLCond，如下图，然后把【class ClCond】代码拷贝进去。然后command + s保存工程文件。切回excel界面就可以进行最终的使用了。（这里先把笔者的代码直接拷贝进去，让实验进行下去）

' 模块1代码
Private conditions As Collection
Sub clearFound()
    getCond().found = False
    getCond().lastMatchIndex = 0
    getCond().lastShapeIndex = 0
End Sub
Function isCondiExists(coll As Collection, key As String) As Boolean
    On Error GoTo EH
    IsObject (coll.Item(key))
    isCondiExists = True
EH:
End Function
Function getCond() As ClCond
    If conditions Is Nothing Then
        Set conditions = New Collection
    End If
    If isCondiExists(conditions, Selection.Application.ActiveWorkbook.Name) Then
        Set getCond = conditions.Item(Selection.Application.ActiveWorkbook.Name)
    Else
        Set getCond = New ClCond
        conditions.Add Item:=getCond, key:=Selection.Application.ActiveWorkbook.Name
    End If

End Function
Sub setKeywords(control As IRibbonControl, text As String)
    '输入完必须按下回车或者tab
    getCond().keywords = text
    Call clearFound
    MsgBox "关键字修改成功为: " & text
End Sub
Sub pressBook(control As IRibbonControl, pressed As Boolean)
    getCond().bookPressed = pressed
    Call clearFound
End Sub
Sub pressEntire(control As IRibbonControl, pressed As Boolean)
    getCond().entirePressed = pressed
    Call clearFound
End Sub
Sub pressScrollToCol(control As IRibbonControl, pressed As Boolean)
    getCond().colPressed = pressed
    Call clearFound
End Sub
Sub pressCaseSensitive(control As IRibbonControl, pressed As Boolean)
    getCond().casePressed = pressed
    Call clearFound
End Sub
Sub pressPrevious(control As IRibbonControl, pressed As Boolean)
    getCond().previousPressed = pressed
End Sub
Sub searchShapeWithKeywordstuxingjiansuo(control As IRibbonControl)
    Dim kws As String
    kws = getCond().keywords
    If kws = "" Then
        MsgBox "keywords empty, please change it" & Chr(13) & _
        "press Tab or Enter, keyword will be changed sucessfully"
        Exit Sub
    End If
    Dim wpSheet As Worksheet
    Dim hasResult As Boolean
    hasResult = False
    If getCond().bookPressed Then
        shSt = 1
        shEd = Selection.Application.ActiveWorkbook.Sheets.Count
        shSp = 1
        If getCond().previousPressed Then
            shSt = Selection.Application.ActiveWorkbook.Sheets.Count
            shEd = 1
            shSp = -1
        End If
        If getCond().found Then
            shSt = getCond().lastMatchIndex
        End If
        
        For j = shSt To shEd Step shSp
            Set wpSheet = Selection.Application.ActiveWorkbook.Sheets(j)
            hasResult = searchInSheets(wpSheet, kws)
            If hasResult Then
                getCond().lastMatchIndex = j
                Exit For
            End If
        Next j
    Else
        Set wpSheet = Selection.Application.ActiveSheet
        hasResult = searchInSheets(wpSheet, kws)
    End If
    If hasResult Then
    Else
        MsgBox kws & " not founed, or reach end" & Chr(13) & "please search again"
        Call clearFound
    End If
End Sub
Function searchInSheets(ByRef wpSheet As Worksheet, kws As String)
    searchInSheets = False
    Dim tShape As Shape
    spSt = 1
    spEd = wpSheet.Shapes.Count
    spSp = 1
    If getCond().previousPressed Then
        spSt = wpSheet.Shapes.Count
        spEd = 1
        spSp = -1
    End If
    If getCond().found Then
        If getCond().previousPressed Then
            spSt = getCond().lastShapeIndex - 1
            If spSt < 1 Then
                Call clearFound
                Exit Function
            End If
        Else
            spSt = getCond().lastShapeIndex + 1
            If spSt > wpSheet.Shapes.Count Then
                Call clearFound
                Exit Function
            End If
        End If
        Call clearFound
    End If
    
    For i = spSt To spEd Step spSp
        Set tShape = wpSheet.Shapes(i)
        If tShape.Visible = msoFalse Then
        Else
            If tShape.AutoShapeType = msoShapeMixed And tShape.Type = msoGroup Then
            Else
                If tShape.TextFrame2.HasText <> -2 And tShape.TextFrame2.HasText <> 0 Then
                If tShape.TextFrame2.TextRange.text <> "" And _
                isMatchingKws(tShape.TextFrame2.TextRange.text, kws) Then
                    wpSheet.Activate
                    tShape.TopLeftCell.Select
                    If getCond().colPressed Then
                        ActiveWindow.ScrollColumn = Selection.Column
                    End If
                    ActiveWindow.ScrollRow = Selection.Row
                    tShape.Select
                    searchInSheets = True
                    getCond().lastShapeIndex = i
                    getCond().found = True
                    Exit Function
                End If
                End If
            End If
        End If
    Next i
End Function
Function isMatchingKws(content, kws)
isMatchingKws = False
    Dim kwArr() As String
    kwArr = Split(kws, ";")
    For Each kw In kwArr
        If kw = "" Then
        Else
            matchKw = kw
            If getCond().entirePressed Then
                matchKw = kw
            Else
                matchKw = "*" & kw & "*"
            End If
            
            If getCond().casePressed Then
                If content Like matchKw Then
                    isMatchingKws = True
                    Exit For
                End If
            Else
                If UCase(content) Like UCase(matchKw) Then
                    isMatchingKws = True
                    Exit For
                End If
            End If
        End If
    Next kw
End Function

' Class ClCond代码
Public keywords As String
Public bookPressed As Boolean
Public entirePressed As Boolean
Public colPressed As Boolean
Public casePressed As Boolean
Public previousPressed As Boolean
Public lastMatchIndex As Integer
Public lastShapeIndex As Integer
Public found As Boolean

测试和使用

测试效果
- 查找 ??cd ，并选中和滚动到这个shape
- 滚动到shape所在列
由于是实验手册，这里仅描述一下开发和测试的过程。最后的功能展示，可以参考笔者的抖音同名账号和b站同名账号的演示。
vba开发步骤
- 首先调试各个custom.xml的onChange, onAction的回调函数。编辑editbox，按下button, checkbox，会成功调用模块1中的回调函数
- 然后先开发最基本的功能，单个sheet中的shape的检索功能，按下检索按钮之后，能够找到一个shape, 选中并滚动到这个shape的位置
- 然后开发默认的【下一个】功能，在excel文件中画出两个shape，能够记录下上一个查找的shapes的序号，查找到下一个shape并且选中
- 然后开发【工作簿检索】功能，我们把查找shape的function方法提取出来，循环sheets，然后重用查找sheet中shape的function。其中需要记录上次查找结果的sheet的序号
- 然后开发【完整匹配】功能，完整匹配的时候，不需要在like条件的前后加上*星号。
- 然后开发【滚动到列】，checkbox勾选上时，添加滚动到列的代码，其实就是ActiveWindow.scrollcolumn = 对应的列
- 然后开发【大小写敏感】的功能，大小写敏感时，不需要对关键字和文本框内容进行UCase(keywords)的操作
- 然后开发【上一个】功能，上一个的时候，我们需要把for循环的开始和结束进行对换，并且如果存在上次查找结果的时候，shapes的开始需要进行减1
- 其实Class来存结果是最后开发的，因为每一个打开的book都是空的。而且暂时决定先不实现customUI.xml中的onLoad方法，所以代码中的内容不会更新到菜单栏中。那么需要进行选择了。选择一个菜单栏在所有的文件中都用同一套条件，还是用不同的条件，我选择了用不同的条件，但是不管怎么样，查询结果和条件都需要按照workbook为单位进行记录。所以就把这些查询条件和查询结果记录在Collection中了。
遇到的坑和bug，
- 如果上一次的检索结果刚好是sheet中的最后一个，那么下一次检索应该是直接在下一个sheet进行检索。由于没有清除检索结果，导致查询下一个sheet的时候，使用了上一个sheet的shape的序号作为开始，导致找不到shape。所以跳到下一个sheet进行检索的时候，需要清除记录下来的shape的序号。
- 多条件查询的分隔符，如果键入了两个;;分号。那么会有一个条件是“”，导致所有的条件都满足。这其实也不算问题。

锁定插件加密vba工程

在后续的使用中，加密可以避免代码被自己不小心修改了，出了什么错也不知道。看了一下其他几个官方插件，默认都是锁定的。
加密方法，同样是右键工程，点击 VBAproject属性...
- 然后勾选上锁定，填入2次密码

参考链接

github/xlwings/xlwings xlwings.xlam https://github.com/xlwings/xlwings/blob/main/xlwings/addin/xlwings.xlam
customUIeditor下载地址 http://github.com/fernandreu/office-ribbonx-editor/releases/latest 往下翻，找到selfcontained版本，exe可以直接执行，不会缺少.net组件。

类似文章

中文customUI的制作 https://blog.csdn.net/fan_jinyong/article/details/4617136
- https://blog.csdn.net/stone0823/article/details/115496320
英文bettersolution整理的网页 https://bettersolutions.com/vba/ribbon/editbox.htm
- https://bettersolutions.com/vba/ribbon/document-level-notepad.htm
搜索引擎的参考的关键字 customUI ribbon vba editbox

后记

本文中已经都给出了所有源代码，完全是足够的。xlam文件就不提供了，不提供后期维护。而且没有最完美的代码，总会有一些修修改改。文章可以修改，xlam文件一定会过时。
由于mac的excel中的vba工程编辑器，写中文错位，非常麻烦，所以后面的弹窗消息，都用英语写了。
正则表达式的功能，由于mac不支持windows的正则表达式的库，所以就不开发了。而且正则表达式用于分析数据比较有用，用来搜索，有些浪费。应该先收集数据，然后再用正则表达式分析，不应该偷懒。
这个工程的源头是一个需求，而且基本上在50行代码就能实现最基本的需求，能够短时间解决问题。才能促使笔者一步步的行动。其他的功能是一点点的顺手完善的。不是一开始就有这么完整的功能，保持简单有效，进退自如。现在也不到200行代码。
本文作为实验手册，是分享实践经验和行业文化，而不是分享需要维护，可能会过时的成果。
如果做完了实验，可以在评论区回复完成。实验手册公开也是因为搜索资料的时候，实在没有比较有效的完整的资料，所以把本实验手册放在公开博客中。实验手册中如果有诸多废话，请多见谅。

标签：文件,插件,End,代码,vba,xlam,手册,getCond
From： https://www.cnblogs.com/oennn/p/18048091

xlam插件制作实验手册

楔子

方法论

前提

基础知识

excel应用安装

需求

实验步骤

步骤概要

customUI.xml制作菜单栏界面

另存为xlam

vba代码开发

测试和使用

锁定插件加密vba工程

参考链接

类似文章

后记

相关文章

赞助商

阅读排行