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

这个问题： 在Excel VBA中search函数的用法让我想到了一个自动search电子表格中使用的所有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循环的语法是什么？

Answer 1

 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 

Answer 2

好吧，我会这么做，因为我会假设你不想从我的资源库中下载VBE类来使它更容易处理，但是它们是作为一个例子，不pipe什么是可能的。

首先，您需要添加一个对Microsoft Visual Basic for Applications Extensibility 5.3库的引用，并允许VBA通过执行以下步骤来访问该编辑器。 （假设Office 2010）

1. 文件
2. 选项
3. 信任中心
4. 信任中心设置
5. macros设置
6. 选中“信任访问VBA项目对象模型”。

现在我们准备探索工作簿中的代码，但是首先要记住我们在这里寻找的东西。

1. function
2. 更具体地说， 公共职能
3. 在标准的* .bas模块（类函数不能是UDF）。
4. 没有Option Private Module

下面的代码在活动的vba项目上工作，但可以修改为一个参数。 它与我在Run子下面提供的快速testing用例一起工作，但是我不能保证它适用于所有的angular落情况。 parsing很难 。 这也只是在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 < codeMod.CountOfLines) procName = codeMod.ProcOfLine(lineNumber, procKind) 'procKind is an OUT param Dim lines() As String Dim procLineCount As Long procLineCount = codeMod.ProcCountLines(procName, procKind) lines = Split(codeMod.lines(lineNumber, procLineCount), vbNewLine) Dim i As Long For i = 0 To UBound(lines) If lines(i) <> 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