创建MyVBA加载宏

2020-07-28 11:34:28 浏览数 (1)

MyVBA加载宏主要功能是设置为自动加载,作为打开其他宏文件的一个程序,做好后大概是这么一个东西:

制作过程:

  • 创建加载宏文件

将所有Excel VBA相关文件都存放到一个目录下面,包括MyVBA加载宏,设置MyVBA加载宏为Excel加载项:

浏览找到文件确定即可,这样打开任何Excel都会自动打开这个文件。

  • 编辑Ribbon界面:

创建一个下拉菜单,这个菜单能够将MyVBA加载宏同路径下面所有后缀为.xlsm和.xlam的文件都添加为子菜单,点击自动打开相应的宏文件,Ribbon菜单代码:

代码语言:javascript复制
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon>
<tabs>
  <tab idMso="TabDeveloper">
    <group id="GroupMyVBA" label="MyVBA">

     <dynamicMenu id="dymOpenAddins" label="打开宏文件&#13;" size="large" imageMso="FileSaveAsExcelXlsxMacro" getContent="dymOpenAddins_getContent"/>

    </group>
  </tab>
</tabs>
</ribbon>
</customUI>

这里使用的是动态dynamicMenu,通过回调函数dymOpenAddins_getContent查找同一文件夹下所有的宏文件,dymOpenAddins_getContent代码:

代码语言:javascript复制
Sub dymOpenAddins_getContent(control As IRibbonControl, ByRef content)
    Dim RetDirs() As String, RetFiles() As String
    
    '查找遍历所有文件
    If ScanDir(ThisWorkbook.Path & "", RetDirs, RetFiles) = -1 Then
        Exit Sub
    End If
    
    Dim i As Long
    Dim icount As Long
    Dim fn As String
    For i = 0 To UBound(RetFiles)
        '过滤本身
        If RetFiles(i) <> ThisWorkbook.FullName Then
            '只显示有VBA的宏文件
            If RetFiles(i) Like "*.xlam" Or RetFiles(i) Like "*.xlsm" Then
                '过滤Excel的临时文件
                If VBA.InStr(RetFiles(i), "~$") = 0 Then
                    '取出文件名称
                    fn = VBA.Mid$(RetFiles(i), VBA.InStrRev(RetFiles(i), "")   1)
                    RetFiles(icount) = VBA.Left$(fn, Len(fn) - 5)
                    '生成Ribbon的xml代码
                    RetFiles(icount) = "      <button id=""" & RetFiles(icount) & """ label=""" & RetFiles(icount) & """ onAction=""rbOpenMacroFile"" imageMso=""FileSaveAsExcelXlsxMacro"" tag=""" & RetFiles(i) & """/>"
                    icount = icount   1
                End If
            End If
        End If
    Next
    
    If icount Then
        ReDim Preserve RetFiles(icount - 1) As String
        '通过回调函数的参数返回xml代码
        content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" & vbNewLine & VBA.Join(RetFiles, vbNewLine) & vbNewLine & "</menu>"
    End If
End Sub

'打开文件,文件名在control的Tag属性里
Sub rbOpenMacroFile(control As IRibbonControl)
    Workbooks.Open control.Tag, False
End Sub

ScanDir是一个比较常用的查找遍历函数,个人创建了一个VBAProject文件夹专门存储这一类文件,把它当作来管理,MyVBA加载宏需要通过工具-引用来使用这个文件,函数代码:

代码语言:javascript复制
Function ScanDir(str_dir As String, RetDirs() As String, RetFiles() As String) As Long
    Dim fso As Object
    Dim file As Object
    Dim folder As Object, subDir As Object
    Dim k As Long

    On Error GoTo err_handle

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.Getfolder(str_dir)

    k = 0
    For Each subDir In folder.Subfolders
        ReDim Preserve RetDirs(k) As String
        RetDirs(k) = subDir.Path
        k = k   1
    Next

    k = 0
    For Each file In folder.Files
        ReDim Preserve RetFiles(k) As String
        RetFiles(k) = file.Path
        k = k   1
    Next file

    ScanDir = k

    Set file = Nothing
    Set folder = Nothing
    Set subDir = Nothing
    Set fso = Nothing

    Exit Function

err_handle:
    ScanDir = -1
End Function

到此MyVBA加载宏创建完成,后续将不断添加具有功能的加载宏,作为exe可执行文件那样管理。

vba

0 人点赞