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
'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
' 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
4条答案
按热度按时间pkmbmrz71#
这里是一个链接到芯片皮尔逊的网站.这是我去每当我需要程序的东西,影响或使用的VBE.有2节,你可能会感兴趣.一个将列出项目中的所有模块.另一个将列出模块中的所有程序.希望这有帮助.
http://www.cpearson.com/excel/vbe.aspx
来自网站的代码(请务必访问网站,以获取有关添加VBIDE对象库引用的说明:
这段代码将列出Module1中的所有过程,从单元格A1开始。
vyu0f0g12#
还有一个免费的工具叫“MZ-Tools”.安装它作为一个插件,它编号你的代码行,生成标准错误管理代码,检查未使用的变量,命令你的函数和子和...文档你的代码,通过自动生成一个列表,你的过程与参数,注解等....一个伟大的工具!
brgchamk3#
对于那些寻找返回字符串集合的函数的人,这里有一些代码改编自guitarthrower的答案:
ProcKind变量只是被丢弃了--这只给出了名称。
p5fdfcr14#