VBA实用小程序49: 列出所有打开工作簿中的VBA模块和过程

学习Excel技术,关注微信公众号:

excelperfect

有时,我们可能需要知道工作簿中有哪些模块和相应的过程。Jon Peltier改编了VBA过程,可以列出当前所有已经打开的工作簿中所含有的VBA模块和过程清单。在输出工作表中,前两行为模块所在工作簿名称和工程名称。并且,代码会绕过受保护的VBA工程,同时如果工作簿中没有代码,也会在输出工作表中说明。

下面是完整的代码:

Sub GetVBAProcedures()
    '声明访问Excel工作簿的变量
    Dim app As Excel.Application
    Dim wb As Excel.Workbook
    Dim wsOutput As Excel.Worksheet
    Dim sOutput() As String
    Dim sFileName As String
    '声明访问工作簿中宏的变量
    Dim vbProj As VBIDE.VBProject
    Dim vbComp As VBIDE.VBComponent
    Dim vbMod As VBIDE.CodeModule
    '声明其它变量
    Dim iRow As Long
    Dim iCol As Long
    Dim iLine As Integer
    Dim sProcName As String
    Dim pk As vbext_ProcKind
    Set app = Excel.Application
    '创建新工作簿用于输出数据
    Set wsOutput =app.Workbooks.Add.Worksheets(1)
    '遍历打开的所有工作簿
    For Each vbProj In app.VBE.VBProjects
        On Error Resume Next
        sFileName = vbProj.Filename
        If Err.Number <> 0 Then sFileName= "文件没有保存"
        On Error GoTo 0
        '初始化输出数组
        ReDim sOutput(1 To 2)
        sOutput(1) = sFileName
        sOutput(2) = vbProj.Name
        iRow = 0
        '检查是否为受保护的工程
        On Error Resume Next
        Set vbComp = vbProj.VBComponents(1)
        On Error GoTo 0
        If Not vbComp Is Nothing Then
            '遍历工程中的每个组件
            For Each vbComp InvbProj.VBComponents
                '找到代码模块
                Set vbMod = vbComp.CodeModule
                '浏览代码模块,查找程序
                iLine = 1
                Do While iLine <vbMod.CountOfLines
                    sProcName =vbMod.ProcOfLine(iLine, pk)
                    If sProcName <>"" Then
                        iRow = iRow + 1
                        ReDim PreservesOutput(1 To 2 + iRow)
                        sOutput(2 + iRow) =vbComp.Name & ": " & sProcName
                        iLine = iLine +vbMod.ProcCountLines(sProcName, pk)
                    Else
                        '这行没有程序,到下一行
                        iLine = iLine + 1
                    End If
                Loop
                Set vbMod = Nothing
                Set vbComp = Nothing
            Next
        Else
            ReDim Preserve sOutput(1 To 3)
            sOutput(3) = "工程被保护"
        End If
        If UBound(sOutput) = 2 Then
            ReDim Preserve sOutput(1 To 3)
            sOutput(3) = "工程中没有代码"
        End If
        '定义输入位置并输出
        IfLen(wsOutput.Range("A1").Value) = 0 Then
            iCol = 1
        Else
            iCol = wsOutput.Cells(1,wsOutput.Columns.Count).End(xlToLeft).Column + 1
        End If
        wsOutput.Cells(1,iCol).Resize(UBound(sOutput) + 1 - LBound(sOutput)).Value =WorksheetFunction.Transpose(sOutput)
        Set vbProj = Nothing
    Next
    wsOutput.UsedRange.Columns.AutoFit
End Sub

在编写代码前,先要设置对“Microsoft Visual Basic for ApplicationsExtensibility 5.3”库的引用。在VBE中,单击菜单“设置——引用”,在下图1所示的对话框中找到“Microsoft Visual Basic forApplications Extensibility 5.3”并选中前面的复选框。

图1

运行GetVBAProcedures过程,在我的当前环境中的输出如下图2所示。

图2

从图2中可以看出,我当前打开了3个工作簿,其中两个没有保存也没有代码,另外的工作簿就是GetVBAProcedures过程代码所在的工作簿,有2个模块3个过程。

GetVBAProcedures过程代码的图片版如下:

原文发布于微信公众号 - 完美Excel(excelperfect)

原文发表时间:2019-05-10

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

发表于

我来说两句

0 条评论
登录 后参与评论

扫码关注云+社区

领取腾讯云代金券