Try this
'---------------------------------------------------------------
Public Function ListMacros(Optional RunTypesOnly As Boolean = True, _
Optional PublicOnly As Boolean = False)
'---------------------------------------------------------------
' Function: List all macros in all workbook projects
' Synopsis: Loops through the designated module processing
' each procedure by:
' - get the number of lines in the procedure
' - searches for the End statement in procedure
' to identify its line number
' - determines the procedure type
' - move onto next procedure
'---------------------------------------------------------------
Const COMPONENT_MODULE As Long = 1
Dim oCodeModule As Object, oComponent As Object
Dim oWb As Workbook
Dim fStart As Boolean
Dim iStart As Long, iCurrent As Long
Dim cLines As Long, cProcs As Long
Dim ProcType As Long '0 Property, 1 Sub, 2 Function
Dim sProcName As String
Dim lProcKind As Long
Dim aryProcs
ReDim aryProcs(1 To 3, 1 To 1)
For Each oWb In Application.Workbooks
Debug.Print oWb.Name
For Each oComponent In oWb.VBProject.VBComponents
Debug.Print "___" & oComponent.Name
If oComponent.Type = COMPONENT_MODULE Then
With oComponent.CodeModule
iStart = .CountOfDeclarationLines + 1
Do Until iStart >= .CountOfLines
'get the procedure name and count of line
'.ProcOfLine modifies ProcKind to type
sProcName = .ProcOfLine(iStart, lProcKind)
cLines = .ProcCountLines(sProcName, lProcKind)
Debug.Print "______" & sProcName
iCurrent = iStart - 1
Do
iCurrent = iCurrent + 1
fStart = .Lines(iCurrent, 1) Like "*Sub *" Or _
.Lines(iCurrent, 1) Like "*Function *"
Or _
.Lines(iCurrent, 1) Like "*Property *"
Loop Until fStart
'determine procedure type
If .Lines(iCurrent, 1) Like "*Sub *" Or _
.Lines(iCurrent, 1) Like "*Function *" Then
If Not PublicOnly Or Not .Lines(iCurrent, 1)
Like "*Private *" Then
If RunTypesOnly Then
If InStr(.Lines(iCurrent, 1), "()") Then
cProcs = cProcs + 1
ReDim Preserve aryProcs(1 To 3, 1 To
cProcs)
aryProcs(1, cProcs) = oWb.Name
aryProcs(2, cProcs) =
oComponent.Name
aryProcs(3, cProcs) = sProcName
End If
Else
cProcs = cProcs + 1
ReDim Preserve aryProcs(1 To 3, 1 To
cProcs)
aryProcs(1, cProcs) = oWb.Name
aryProcs(2, cProcs) = oComponent.Name
aryProcs(3, cProcs) = sProcName
End If
End If
End If
'onto the next procedure
iStart = iStart + _
.ProcCountLines(sProcName, lProcKind)
Loop
End With 'oComponent
End If
Next oComponent
Next oWb
ListMacros = aryProcs
End Function
