循环虽然项目中的所有UDF名称

这个问题:在Excel VBA中搜索函数用法让我想到了一个自动搜索电子表格中使用的所有UDF的过程.有点像:

For Each UDF in Module1
    If Cells.Find(What:=UDF.Name, After:="A1", LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False) Then
        MsgBox UDF.Name & " is in use"
    End If
Next UDF

这是可能的,如果是这样,循环遍历所有UDF的语法是什么？

好吧,我将以艰难的方式做到这一点,因为我将假设您不想从我的存储库下载VBE类以使其更容易使用,但它们是作为一个可能的例子,无论如何.

首先,您需要添加对Microsoft Visual Basic for Applications Extensibility 5.3 Library的引用,并允许VBA通过执行以下步骤来访问编辑器.(假设Office 2010)

文件

选项

信托中心

信任中心设置

宏设置

选中"信任对VBA项目对象模型的访问".

现在我们已经准备好探索工作簿中的代码了,但首先要记住一些我们正在寻找的内容.

功能

更具体地说,公共职能

在标准*.bas模块中(类函数不能是UDF).

没有Option Private Module

下面的代码适用于活动的vba项目,但可以修改为将其作为参数.它适用于我在Runsub 下面提供的快速测试用例,但我不保证它适用于所有角落情况.解析很难.这也只是在results集合中存储和打印功能签名.我想,实际上你会想要一个返回它们的函数,这样你就可以循环遍历集合,在工作簿中查找它们.

Option Explicit

Private Sub Run()
    Dim results As New Collection

    Dim component As VBIDE.VBComponent
    For Each component In Application.VBE.ActiveVBProject.VBComponents

        If component.Type = vbext_ct_StdModule Then
            ' find public functions with no arguments
            Dim codeMod As CodeModule
            Set codeMod = component.CodeModule

            If InStr(1, codeMod.Lines(1,codeMod.CountOfDeclarationLines), "Option Private Module") = 0 Then

                Dim lineNumber As Long
                lineNumber = codeMod.CountOfDeclarationLines + 1

                Dim procName As String
                Dim procKind As vbext_ProcKind
                Dim signature As String

                ' loop through all lines in the module
                While (lineNumber  vbNullString And Left(Trim(lines(i)), 1) <> "'" Then
                            signature = lines(i)
                            Exit For
                        End If
                    Next

                    ' this would need better parsing, but should be reasonably close
                    If InStr(1, signature, "Public Function", vbTextCompare) > 0 Then 'first make sure we have a public function
                        results.Add signature
                    End If

                    lineNumber = lineNumber + procLineCount + 1 ' skip to next procedure
                Wend

            End If

        End If
    Next component

    Dim str
    For Each str In results
        Debug.Print str
    Next
End Sub

Public Function foo()

End Function

Private Function bar()

End Function

Public Function qwaz(duck)

End Function

Option Explicit

' Add reference to Microsoft Visual Basic for Applications Extensibility 5.3 Library

Public Sub FindFunctionUsage()
    Dim udfs
    udfs = ListProcedures("Module1")
    If Not IsArray(udfs) Then _
        Exit Sub

    Dim udf
    Dim findResult

    For Each udf In udfs
        Set findResult = Cells.Find(What:="=" & udf, After:=Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False)

        If Not findResult Is Nothing Then _
            MsgBox udf & " is in use"
    Next udf
End Sub

' Source for ListProcedures : http://www.cpearson.com/excel/vbe.aspx
Private Function ListProcedures(moduleName As String)
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(moduleName)
        Set CodeMod = VBComp.CodeModule

        Dim result
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                If ProcKindString(ProcKind) = "Sub Or Function" Then
                    If IsArray(result) Then
                        ReDim Preserve result(LBound(result) To UBound(result) + 1)
                    Else
                        ReDim result(0 To 0)
                    End If
                    result(UBound(result)) = ProcName
                End If

                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
            Loop
        End With
        ListProcedures = result
    End Function

    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
    End Function

' Content of Module1
Public Sub Sub1()

End Sub

Public Function Func1(ByRef x As Range)

End Function

Public Sub Sub2()

End Sub