vba 如何在Excel VBA中获取给定模块名称的Function和Sub列表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2630872/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
how to get the list of Function and Sub of a given module name in Excel VBA
提问by Kratz
I am working on a helper macro that look into the list function on a given module name on the active excel workbook. Ex: I have a module name "Module1". Inside this module has the following function or sub
我正在研究一个帮助程序宏，它查看活动 excel 工作簿上给定模块名称的列表函数。例如：我有一个模块名称“Module1”。这个模块里面有以下功能或子
Sub Sub1()
End Sub
Sub Sub2()
End Sub
Function Func1()
End Function
Function Func2()
End Function
Is there a command or routine that can return the list of Function and Sub names?
是否有可以返回函数和子名称列表的命令或例程？
采纳答案by guitarthrower
Here is a link to Chip Pearson's site. This is where I go whenever I need to program something that affects or uses the VBE. There are 2 sections that might interest you. One will list all modules in a project. And another will list all procedures in a module. Hope that helps.
这是 Chip Pearson 网站的链接。每当我需要编写影响或使用 VBE 的东西时，我都会去这里。有 2 个部分您可能会感兴趣。将列出项目中的所有模块。另一个将列出模块中的所有程序。希望有帮助。
http://www.cpearson.com/excel/vbe.aspx
http://www.cpearson.com/excel/vbe.aspx
Code from the site (make sure to visit the site for instructions on adding a reference to the VBIDE object library:
来自站点的代码（确保访问该站点以获取有关添加对 VBIDE 对象库的引用的说明：
This code will list all the procedures in Module1, beginning the listing in cell A1.
此代码将列出 Module1 中的所有过程，从单元格 A1 中的列表开始。
Sub ListProcedures()
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("Module1")
Set CodeMod = VBComp.CodeModule
Set WS = ActiveWorkbook.Worksheets("Sheet1")
Set Rng = WS.Range("A1")
With CodeMod
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
Rng.Value = ProcName
Rng(1, 2).Value = ProcKindString(ProcKind)
LineNum = .ProcStartLine(ProcName, ProcKind) + _
.ProcCountLines(ProcName, ProcKind) + 1
Set Rng = Rng(2, 1)
Loop
End With
End Sub
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
回答by Philippe Grondier
There is also a free tool called "MZ-Tools". Install it as an add-in, It numbers your lines o fcode, generate standard error management code, check unused variables, order your functions and sub and ... document your code, by automatically generating a list of your procedures with parameters, comments, etc.... A great tool!
还有一个名为“MZ-Tools”的免费工具。将其安装为插件，它会为您的代码行编号，生成标准错误管理代码，检查未使用的变量，对您的函数进行排序，并...记录您的代码，通过自动生成带有参数、注释的过程列表，等等......一个很棒的工具！
回答by Colm Bhandal
For those looking for a function returning a collection of Strings, here is some code adapted from guitarthrower's answer:
对于那些正在寻找返回字符串集合的函数的人，这里有一些改编自 Guitarthrower 回答的代码：
'Collection of Strings of Sub names in that module
Private Function getAllProcNames(module As VBIDE.CodeModule) As Collection
Dim lineNum As Integer
Dim procName As String
Dim coll As New Collection
Dim ProcKind As VBIDE.vbext_ProcKind
With module
lineNum = .CountOfDeclarationLines + 1
Do Until lineNum >= .CountOfLines
procName = .ProcOfLine(lineNum, ProcKind)
lineNum = .ProcStartLine(procName, ProcKind) + _
.ProcCountLines(procName, ProcKind) + 1
coll.Add Item:=procName
Loop
End With
Set getAllProcNames = coll
End Function
The ProcKind variable is just thrown away- this gives names only.
ProcKind 变量只是被扔掉了——这只是给出了名字。
回答by Harry S
' a bit more info for those who like me looking for help
' without Chip Pearson and many others my programming would still be at
' x=x+4
Option Explicit
'
' to list or sort procedure names
'
'
' on a spare sheet
'
Private Sub CommandButton1_Click()
Dim URA$, RaSort As Range, ModName$, VBC As VBComponent
Dim RangeStartAddress$: RangeStartAddress = "H11" ' any spare region
Set RaSort = Range(RangeStartAddress)
' sort and display needs 5 un-bordered columns so best done from spare worksheet
RaSort(0, 0).Resize(UsedRange.Rows.Count, 7).Clear
URA = UsedRange.Address ' tidy of used range
ModName = [c6]
' from cell C4 ... or whatever is needed name is needed
' OR ... to do all modules ... Skipping workbook try something like
'
'For Each VBC In ActiveWorkbook.VBProject.VBComponents
' Range("G11:N" & UsedRange.Rows.Count).Clear
' URA = UsedRange.Address
'Set RaSort = Range("h11")
'If Not (VBC.Name Like "Workbook") Then
' SortSUBLGFUN VBC.Name, RaSort
'End If
' Next VBC
SortSUBLGFUN ModName, RaSort
End Sub
'
' in a module
'
' sort the procedure names for a module
' Reference to VBE .. Microsoft Visual Basic for Applications Extensibility
' RaSort as some spare Range CurrentRegion
'
Sub SortSUBLGFUN(ComponentName$, RaSort As Range)
Dim LineI%, PBLI&, RowI&, RowOut&, LineStr$
Dim PLSG As vbext_ProcKind ' 0 Fun or Sub 1 Let 2 Set 3 Get
Dim ProcName$
Dim StartLineI&, CountLinesI&, LinesOfProc$
With ActiveWorkbook.VBProject.VBComponents(ComponentName).CodeModule
LineI = .CountOfDeclarationLines + 1
While LineI < .CountOfLines
PLSG = 0
While PLSG < 3 And LineI < .CountOfLines ' look for all types
On Error GoTo LookMore ' msny may not exist
ProcName = .ProcOfLine(LineI, PLSG)
CountLinesI = .ProcCountLines(ProcName, PLSG)
StartLineI = .ProcStartLine(ProcName, PLSG)
RowOut = RowOut + 1
RaSort(RowOut, 1) = ProcName
RaSort(RowOut, 2) = PLSG
RaSort(RowOut, 3) = StartLineI
RaSort(RowOut, 4) = CountLinesI
' the procedure can have blanks or comment lines at the top
' so start line is not always the Procedure body line
' the ProcBodyLine may be extended for over about 20 lines
' using the line-continuation char " _"
' so it looks a bit complex to find the actual line
PBLI = .ProcBodyLine(ProcName, PLSG)
LineStr = .Lines(PBLI, 1)
While Right(LineStr, 2) = " _" ' if extended get the other lines
PBLI = PBLI + 1
LineStr = Left(LineStr, Len(LineStr) - 2) & " " & .Lines(PBLI, 1)
Wend
RaSort(RowOut, 5) = LineStr
LineI = StartLineI + CountLinesI + 1
If LineI > .CountOfLines Then PLSG = 14 ' > 3
LookMore:
On Error GoTo 0
PLSG = PLSG + 1
Wend
LineI = LineI + 1
Wend
Set RaSort = RaSort.CurrentRegion
RaSort.Sort RaSort(1, 1), xlAscending
'
'bring each to the top from Z to A results in sorted alphabetically
'
For RowI = RaSort.Rows.Count To 1 Step -1
ProcName = RaSort(RowI, 1)
PLSG = RaSort(RowI, 2)
'
' since they have moved need to refind them before moving to top
'
CountLinesI = .ProcCountLines(ProcName, PLSG)
StartLineI = .ProcStartLine(ProcName, PLSG)
LinesOfProc = .Lines(StartLineI, CountLinesI)
.DeleteLines StartLineI, CountLinesI
.InsertLines .CountOfDeclarationLines + 1, LinesOfProc
Next RowI
End With
End Sub
'
' you may find the two below of interest
'
Sub TabsAscending()
Dim I&, J&
For I = 1 To Application.Sheets.Count
For J = 1 To Application.Sheets.Count - 1
If UCase$(Application.Sheets(J).Name) > UCase$(Application.Sheets(J + 1).Name) then
Sheets(J).Move after:=Sheets(J + 1)
End If
Next J
Next I
End Sub
Sub ResetCodeNames(WkWb As Workbook)
'Changes the codename conventional name gets rid of Sheet3 Sheet7 where they have been given a name
Dim VarItem As VBIDE.VBComponent
For Each VarItem In WkWb.VBProject.VBComponents
'Type 100 is a worksheet
If VarItem.Type = 100 And VarItem.Name <> "ThisWorkbook" Then
VarItem.Name = VarItem.Properties("Name").Value
End If
Next
End Sub
' hope it helps others
