基于上一篇文章的成功：在 MS Project 中，我如何列出所有子例程及其模块名称
我正在使用 http://www.cpearson.com/excel/vbe.aspx 中的代码来搜索宏中的文本。
我目前正在搜索一些简单的文本，但最终我将循环一组文本（子函数名称）并在每个模块中的每个子函数和函数中搜索它们，以便我可以报告哪些宏和函数调用其他子函数和函数。
代码是：
'.vbVisual Basic
'---------------------------------------------------------------------------------------
' Purpose : Prints all subs and functions in a project
' Prerequisites: Microsoft Visual Basic for Applications Extensibility 5.3 library
' CreateLogFile
' How to run: Run GetFunctionAndSubNames, set a parameter to blnWithParentInfo
' If ComponentTypeToString(vbext_ct_StdModule) = "Code Module" Then
'
' Used: ComponentTypeToString from -> http://www.cpearson.com/excel/vbe.aspx
'---------------------------------------------------------------------------------------
'taken from https://www.vitoshacademy.com/vba-listing-all-procedures-in-all-modules/
'slight modiications to display the module names and customise for MS Project rather than Excel
'changed CreateLogFile to Debug.print
'added choice of how to display the modules
Option Explicit
Private strSubsInfo As String
Public Sub X_GetFunctionAndSubNames()
Dim item As Variant
strSubsInfo = ""
Dim displaychoice As Integer
displaychoice = InputBox("How do you want to display the module names?:" & vbCrLf & "1 = In line with the Procedure Names, seperated by a ':'" & vbCrLf & "2 = The Module name: and then the Procedure names under the Module")
If Not (displaychoice = 1 Or displaychoice = 2) Then
MsgBox ("Only 1 or 2 can be chosen, the code will now exit")
Exit Sub
End If
For Each item In ThisProject.VBProject.VBComponents 'ThisWorkbook.VBProject.VBComponents
If ComponentTypeToString(vbext_ct_StdModule) = "Code Module" Then
ListProcedures item.Name, displaychoice, False
'Debug.Print item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
End If
Next item
Debug.Print strSubsInfo
Chain_slack.Clipboard (strSubsInfo)
MsgBox ("The procedure and module names have been printed to the Immediate window and has been saved to the Clipboard")
'CreateLogFile strSubsInfo
End Sub
Private Sub ListProcedures(strName As String, displaychoice As Integer, Optional blnWithParentInfo = False)
'Microsoft Visual Basic for Applications Extensibility 5.3 library is needed for this to run.
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim ProcName As String
Dim ModuleName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Dim Start_row As Long
Dim End_row As Long
Dim FindThis As String
Set VBProj = ThisProject.VBProject 'ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(strName)
Set CodeMod = VBComp.CodeModule
ModuleName = VBComp.CodeModule.Name
FindThis = "find this here"
If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & "Module - " & ModuleName
With CodeMod
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
Start_row = LineNum
End_row = Start_row + .ProcCountLines(ProcName, ProcKind) + 1
If blnWithParentInfo Then
If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName
If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName & " : " & ModuleName
Else
If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName
If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName & " : " & ModuleName
End If
LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
'within this loop can I use the search sub (turned into a functon) from http://www.cpearson.com/excel/vbe.aspx to look from the start line to the end line of this proc
'and loop thorugh an array or string (easier to transfer fom the starting function?) to see if the proc contains any of the names in the string/array?
'start with a simple term which has been seeded through the project in known places before starting to loop through the various search terms
If SearchCodeModule(ModuleName, Start_row, End_row, FindThis) = True Then Debug.Print ModuleName & ": " & ProcName & " contains " & FindThis & " " & Start_row & "-" & End_row
Loop
End With
End Sub
Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
'ComponentTypeToString from http://www.cpearson.com/excel/vbe.aspx
Select Case ComponentType
Case vbext_ct_ActiveXDesigner
ComponentTypeToString = "ActiveX Designer"
Case vbext_ct_ClassModule
ComponentTypeToString = "Class Module"
Case vbext_ct_Document
ComponentTypeToString = "Document Module"
Case vbext_ct_MSForm
ComponentTypeToString = "UserForm"
Case vbext_ct_StdModule
ComponentTypeToString = "Code Module"
Case Else
ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
End Select
End Function
Function SearchCodeModule(module_name As String, SL As Long, EL As Long, FindWhat As String)
'from http://www.cpearson.com/excel/vbe.aspx
'should be returning a true or false
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
'Dim FindWhat As String
'Dim SL As Long ' start line
'Dim EL As Long ' end line
Dim SC As Long ' start column
Dim EC As Long ' end column
Dim Found As Boolean
Set VBProj = ThisProject.VBProject
Set VBComp = VBProj.VBComponents(module_name)
Set CodeMod = VBComp.CodeModule
'FindWhat = "findthis"
With CodeMod
'SL = 1
'EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=False, patternsearch:=False)
'Do Until Found = False
' Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
' EL = .CountOfLines
' SC = EC + 1
' EC = 255
' Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
' EndLine:=EL, EndColumn:=EC, _
' wholeword:=True, MatchCase:=False, patternsearch:=False)
'Loop
End With 'why are SL and EL set to equal the location of the string and also the values for StartLine and EndLine are set to the same; how can I keep these for the next loop?
SearchCodeModule = Found 'Debug.Print Found
End Function
在进入 Sub ListProcedures 中的循环时，当前过程的行的开始和结束记录在 Start_row 和 End_row 中。这些值被传递给 Seach 函数以限制每个模块内的搜索区域。 问题是，当搜索函数找到匹配项（即 Found = True）时，SL、EL、Start_Row 和 End_row 的值都会成为找到搜索文本的行。 这是一个问题，因为将来当我循环遍历所有可能的搜索字符串时，我将需要 Start_row 和 End_row 保持不变。 为什么会这样做以及如何修复它？ :) 非常感谢您帮助我继续学业。
Public Sub X_GetFunctionAndSubNames()
Dim vbProj As VBIDE.VBProject
Set vbProj = ThisProject.VBProject
Dim Item As VBIDE.VBComponent
For Each Item In vbProj.VBComponents
If Item.Type = vbext_ct_StdModule Then
Dim SubsInfo As String
SubsInfo = SubsInfo & vbCrLf & ListProcedures(vbProj, Item)
End If
Next Item
Debug.Print SubsInfo
'Chain_slack.Clipboard (SubsInfo)
MsgBox "The procedure and module names have been printed to the Immediate window and has been saved to the Clipboard"
End Sub
Function ListProcedures(vbProj As VBIDE.VBProject, module As VBIDE.VBComponent) As String
Dim modInfo As String
modInfo = module.Name
Dim ProcKind As VBIDE.vbext_ProcKind
ProcKind = vbext_pk_Proc
With module.CodeModule
Dim LineNum As Long
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
Dim procName As String
procName = .ProcOfLine(LineNum, ProcKind)
modInfo = modInfo & vbCrLf & vbTab & procName & FindCalls(vbProj, procName)
LineNum = .ProcStartLine(procName, ProcKind) + .ProcCountLines(procName, ProcKind) + 1
Loop
End With
ListProcedures = modInfo
End Function
Function FindCalls(vbProj As VBIDE.VBProject, procName As String) As String
Dim VBComp As VBIDE.VBComponent
For Each VBComp In vbProj.VBComponents
If VBComp.Type = vbext_ct_StdModule Then
With VBComp.CodeModule
Dim callInfo As String
Dim SL As Long
SL = 0
Do Until Not .Find(procName, SL, 0, .CountOfLines, 0, WholeWord:=True)
Dim foundIn As String
foundIn = .ProcOfLine(SL, vbext_pk_Proc)
If procName <> foundIn And Len(foundIn) > 0 Then
callInfo = callInfo & vbCrLf & vbTab & vbTab & "called by " & foundIn & " on line " & SL
End If
SL = SL + 1
Loop
End With
End If
Next VBComp
FindCalls = callInfo
End Function
过程名称在模块名称下方缩进显示，然后缩进在模块名称下方是调用它们的列表。
BuildVBAModel
X_GetFunctionAndSubNames
ListProcedures
called by X_GetFunctionAndSubNames on line 14
FindCalls
called by ListProcedures on line 42
Module2
MainProc
Func1
called by MainProc on line 6
called by MainProc on line 11
ProcB
called by MainProc on line 8
called by MainProc on line 13