Created by Stephen Bullen
The problem – you want to programatically obtain the name of the
VBComponent that contains a specified procedure. Stephen’s solution
was to look for unique strings, since the VBIDE object model does
not provide functionality for doing this directly.
Sub TestIt()
MsgBox fnThisVBComponent(ThisWorkbook, “This Unique String”).Name & “, “ & _
fnThisProcedureName(ThisWorkbook, “Another Unique String”)
End Sub
Function fnThisVBComponent(oBk As Workbook, sUniqueString As String) As VBComponent
Dim oVBC As VBComponent
‘Loop through the VBComponents in the given workbook’s VBProject
For Each oVBC In oBk.VBProject.VBComponents
‘Using it’s code module
With oVBC.CodeModule
‘See if we can find the unique string
If .Find(sUniqueString, 1, 1, .CountOfLines, 1000, True, _
True, False) Then
‘Found it, so return the VBComponent where it was found
Set fnThisVBComponent = oVBC
Exit For
End If
End With
Next
End Function
Function fnThisProcedureName(oBk As Workbook, sUniqueString As String) As String
Dim oVBC As VBComponent
Dim lStart As Long, sProcName As String, vaProcs As Variant, vProcType As Variant
‘Specify the row number of where to start the find. This is set by
‘the Find method to give the (starting) line number where the text
‘was found. lStart = 1
‘Loop through the VBComponents in the given workbook’s VBProject
For Each oVBC In oBk.VBProject.VBComponents
‘Using it’s code module
With oVBC.CodeModule
‘See if we can find the unique string
If .Find(sUniqueString, lStart, 1, .CountOfLines, 1000, True, _
True, False) Then
‘We found it, so make an array of the available procedure
‘types to check for
vaProcs = Array(vbext_pk_Proc, vbext_pk_Get, vbext_pk_Let, _
vbext_pk_Set)
‘Loop throguh the procedure types
For Each vProcType In vaProcs
‘Get the name of the procedure containing the line we
‘found above
sProcName = .ProcOfLine(lStart, CLng(vProcType))
‘Did we get a procedure name?
If sProcName <> “” Then
‘We did, so return it
fnThisProcedureName = sProcName
Exit For
End If
Next
Exit For
End If
End With
Next
End Function
MsgBox fnThisVBComponent(ThisWorkbook, “This Unique String”).Name & “, “ & _
fnThisProcedureName(ThisWorkbook, “Another Unique String”)
End Sub
Function fnThisVBComponent(oBk As Workbook, sUniqueString As String) As VBComponent
Dim oVBC As VBComponent
‘Loop through the VBComponents in the given workbook’s VBProject
For Each oVBC In oBk.VBProject.VBComponents
‘Using it’s code module
With oVBC.CodeModule
‘See if we can find the unique string
If .Find(sUniqueString, 1, 1, .CountOfLines, 1000, True, _
True, False) Then
‘Found it, so return the VBComponent where it was found
Set fnThisVBComponent = oVBC
Exit For
End If
End With
Next
End Function
Function fnThisProcedureName(oBk As Workbook, sUniqueString As String) As String
Dim oVBC As VBComponent
Dim lStart As Long, sProcName As String, vaProcs As Variant, vProcType As Variant
‘Specify the row number of where to start the find. This is set by
‘the Find method to give the (starting) line number where the text
‘was found. lStart = 1
‘Loop through the VBComponents in the given workbook’s VBProject
For Each oVBC In oBk.VBProject.VBComponents
‘Using it’s code module
With oVBC.CodeModule
‘See if we can find the unique string
If .Find(sUniqueString, lStart, 1, .CountOfLines, 1000, True, _
True, False) Then
‘We found it, so make an array of the available procedure
‘types to check for
vaProcs = Array(vbext_pk_Proc, vbext_pk_Get, vbext_pk_Let, _
vbext_pk_Set)
‘Loop throguh the procedure types
For Each vProcType In vaProcs
‘Get the name of the procedure containing the line we
‘found above
sProcName = .ProcOfLine(lStart, CLng(vProcType))
‘Did we get a procedure name?
If sProcName <> “” Then
‘We did, so return it
fnThisProcedureName = sProcName
Exit For
End If
Next
Exit For
End If
End With
Next
End Function
Be sure to set a reference to the Microsoft Visual Basic for Application Extensibility Library.
I’ve always adopted the habit of creating an array of Module Names and Procedure Names for each Module. That way I’ve always got it available. Detailks of the functions I developed are on http://www.instantpages.ltd.uk under VBA Functions.