I found some code in my standard library that you might find useful:
' Requires a reference to:
' Name: VBIDE
' Description: Microsoft Visual Basic for Applications
Extensibility 5.3
' GUID: {0002E157-0000-0000-C000-000000000046}
' Major: 5 Minor: 3
' Typical Location: C:\Program Files\Common Files\Microsoft
Shared\VBA\VBA6\VBE6EXT.OLB
Public Type TDeclarationInfo
Success As Boolean
ProcName As String
ProcType As String
ProcKind As VBIDE.vbext_ProcKind
Scope As String
ProcBodyLine As Long
ProcStartLine As Long
ProcEndLine As Long
ProcCountLines As Long
Declaration As String
NormalizedDeclaration As String
End Type
Function ProcInfoFromLine(CodeMod As VBIDE.CodeModule, LineNumber As
Long) As TDeclarationInfo
Dim SS As Variant
Dim N As Long
Dim DI As TDeclarationInfo
Dim S As String
Dim T As String
With CodeMod
If LineNumber <= .CountOfDeclarationLines Then
DI.Success = False
ProcInfoFromLine = DI
Exit Function
End If
DI.ProcName = .ProcOfLine(LineNumber, DI.ProcKind)
DI.ProcStartLine = .ProcStartLine(DI.ProcName, DI.ProcKind)
DI.ProcBodyLine = .ProcBodyLine(DI.ProcName, DI.ProcKind)
DI.ProcCountLines = .ProcCountLines(DI.ProcName, DI.ProcKind)
DI.ProcEndLine = DI.ProcStartLine + DI.ProcCountLines - 1
N = 0
S = .Lines(DI.ProcBodyLine + N, 1)
Do Until StrComp(Right(S, 2), " _", vbBinaryCompare) <> 0
N = N + 1
T = .Lines(DI.ProcBodyLine + N, 1)
S = S & vbNewLine & T
Loop
DI.Declaration = S
T = S
T = Replace(T, vbNewLine, Space(1))
T = Replace(T, " _ ", Space(1))
N = InStr(1, T, Space(2))
Do Until N = 0
T = Replace(T, Space(2), Space(1))
N = InStr(1, T, Space(2))
Loop
DI.NormalizedDeclaration = T
SS = Split(DI.NormalizedDeclaration, Space(1))
Select Case DI.ProcKind
Case VBIDE.vbext_pk_Get
DI.ProcType = "Property Get"
Select Case LCase(SS(0))
Case "public", "private", "friend"
DI.Scope = SS(0)
Case Else
DI.Scope = "default"
End Select
Case VBIDE.vbext_pk_Let
DI.ProcType = "Property Let"
Select Case LCase(SS(0))
Case "public", "private", "friend"
DI.Scope = SS(0)
Case Else
DI.Scope = "default"
End Select
Case VBIDE.vbext_pk_Set
DI.ProcType = "Property Set"
Select Case LCase(SS(0))
Case "public", "private", "friend"
DI.Scope = SS(0)
Case Else
DI.Scope = "default"
End Select
Case VBIDE.vbext_pk_Proc
Select Case LCase(SS(0))
Case "public", "private", "friend"
DI.Scope = SS(0)
DI.ProcType = SS(1)
Case Else
DI.Scope = "default"
DI.ProcType = SS(0)
End Select
End Select
DI.Success = True
End With
ProcInfoFromLine = DI
End Function
The ProcInfoFromLine function takes as input a reference to a
VBIDE.CodeModule and a LineNumber and loads and returns a
TDeclarationInfo structure with many properties of the procedure that
contains LineNumber in CodeMod.
The elements of the TDeclarationInfo structure are for the most part
self-explanatory. ProcType is a string contain the type of procedure,
eg., "Sub", "Property Get", etc. ProcKind is the vbext_ProcKind value
of the procedure. Scope is "public", "private","friend", or "default
(no scope specified)". Declaration is the complete declaration of the
procedure, including line continuation characters and line breaks, and
padding space if the declaration spans more than one line in the code.
NormalizeDeclaration is the declaration with all lines breaks, and
line continuation characters stripped out, and then it is single
spaced (multiple spaces convert to single spaces).
Once you have the code above, you would call it with code like
Sub AAATest()
Dim VBP As VBIDE.VBProject
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim ModuleName As String
Dim DI As TDeclarationInfo
'<<< CHANGE THE NEXT TWO LINES AS DESIRED
ModuleName = "Module1"
LineNum = 20
'<<< END CHANGE
Set VBP = Application.VBE.ActiveVBProject
Set CodeMod = VBP.VBComponents(ModuleName).CodeModule
DI = ProcInfoFromLine(CodeMod, LineNum)
If DI.Success = False Then
Debug.Print "error"
Else
With DI
Debug.Print "---------------------"
Debug.Print "PROC:", .ProcName
Debug.Print "---------------------"
Debug.Print "Scope", .Scope
Debug.Print "ProcType", .ProcType
Debug.Print "ProcKind", .ProcKind
Debug.Print "ProcStart", .ProcStartLine
Debug.Print "ProcBodyLine", .ProcBodyLine
Debug.Print "ProcCountLines", .ProcCountLines
Debug.Print "ProcEndLine", .ProcEndLine
Debug.Print "NormalizedDeclaration", .NormalizedDeclaration
Debug.Print "Declaration", .Declaration
Debug.Print "---------------------"
End With
End If
End Sub
All this code comes for a project I've been working on to build a
complete VBA code management and control system. The management
project is written in VBNET 2008, NET 3.5.1 and, if all goes well, can
be used in any Office application and using an SQL Server Express
database.
I hope you find the code helpful, or at least amusing.
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
