Sample Code
Adding A Module To A Project
This code will add new code module named NewModule to the VBProject of the active workbook. The type of VBComponent is specified by the value of the parameter passed to the Add method.
Public Sub AddModuleToProject()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "NewModule"
End Sub
Adding A Procedure To A Module
This code will add a simple "Hello World" procedure named SayHello to the end of the module named Module1.
Public Sub AddProcedureToModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Public Sub SayHello()"
LineNum = LineNum + 1
.InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
End Sub
Creating An Event Procedure
This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used.
This code will create the declaration line and the end of procedure line. It returns the line number on which the event procedure begins.
Public Sub CreateEventProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CreateEventProc("Open", "Workbook")
LineNum = LineNum + 1
.InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE
End With
End Sub
Deleting A Module From A Project
This code will delete Module1 from the VBProject. Note that you cannot remove any of the Sheet modules or the ThisWorkbook module.
In general, you cannot delete a module whose Type is vbext_ct_Document.
Public Sub DeleteModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
VBProj.VBComponents.Remove VBComp
End Sub
Deleting A Procedure From A Module
This code will delete the procedure DeleteThisProc from the Module1.
You must specify the procedure type in order to differentiate between Property Get, Property Let, and Property Set procedure, all of which have the same name.
Public Sub DeleteProcedureFromModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
ProcName = "DeleteThisProc"
With CodeMod
StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
.DeleteLines StartLine:=StartLine, Count:=NumLines
End With
End Sub
Deleting All VBA Code In A Project
This code will delete ALL VBA code in a VBProject.
Public Sub DeleteAllVBACode()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = ActiveWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
If (VBComp.Type = vbext_ct_Document) Then
Set CodeMod = VBComp.CodeModule
CodeMod.DeleteLines 1, .CountOfLines
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
End Sub
Exporting A VBComponent Code Module To A Text File
You can export an existing VBComponent CodeModule to a text file.
If FileName is missing, the code will be exported to a file with the same name as the VBComponent followed by the appropriate extension.
This can be useful if you are archiving modules to create a library of useful module to be used in other projects.
Public Function ExportVBComponent(ByVal VBComp As VBIDE.VBComponent, _
ByVal FolderName As String, _
Optional ByVal FileName As String, _
Optional ByVal OverwriteExisting As Boolean = True) As Boolean
Dim Extension As String
Dim FName As String
Extension = GetFileExtension(VBComp:=VBComp)
If Trim(FileName) = vbNullString Then
FName = VBComp.Name & Extension
Else
FName = FileName
If InStr(1, FName, ".", vbBinaryCompare) = 0 Then
FName = FName & Extension
End If
End If
If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then
FName = FolderName & FName
Else
FName = FolderName & "\" & FName
End If
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
If OverwriteExisting = True Then
Kill FName
Else
ExportVBComponent = False
Exit Function
End If
End If
VBComp.Export FileName:=FName
ExportVBComponent = True
End Function
Public Function GetFileExtension(ByVal VBComp As VBIDE.VBComponent) As String
Select Case VBComp.Type
Case vbext_ct_ClassModule
GetFileExtension = ".cls"
Case vbext_ct_Document
GetFileExtension = ".cls"
Case vbext_ct_MSForm
GetFileExtension = ".frm"
Case vbext_ct_StdModule
GetFileExtension = ".bas"
Case Else
GetFileExtension = ".bas"
End Select
End Function
Listing All Modules In A Project
This code will list all the modules and their types in the workbook, starting the listing in cell A1.
Public Sub ListModules()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim WS As Worksheet
Dim Rng As Range
Set VBProj = ActiveWorkbook.VBProject
Set WS = ActiveWorkbook.Worksheets("Sheet1")
Set Rng = WS.Range("A1")
For Each VBComp In VBProj.VBComponents
Rng(1, 1).Value = VBComp.Name
Rng(1, 2).Value = ComponentTypeToString(VBComp.Type)
Set Rng = Rng(2, 1)
Next VBComp
End Sub
Public Function ComponentTypeToString(ByVal ComponentType As VBIDE.vbext_ComponentType) As String
Select Case ComponentType
Case vbext_ct_ActiveXDesigner
ComponentTypeToString = "ActiveX Designer"
Case vbext_ct_ClassModule
ComponentTypeToString = "Class Module"
Case vbext_ct_Document
ComponentTypeToString = "Document Module"
Case vbext_ct_MSForm
ComponentTypeToString = "UserForm"
Case vbext_ct_StdModule
ComponentTypeToString = "Code Module"
Case Else
ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
End Select
End Function
Listing All Procedures In A Module
This code will list all the procedures in Module1, beginning the listing in cell A1.
Public 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
ProcName = .ProcOfLine(LineNum, ProcKind)
Do Until LineNum >= .CountOfLines
Rng(1, 1).Value = ProcName
Rng(1, 2).Value = ProcKindString(ProcKind)
Set Rng = Rng(2, 1)
LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) + 1
ProcName = .ProcOfLine(LineNum, ProcKind)
Loop
End With
End Sub
Public Function ProcKindString(ByVal 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
Searching For Text In A Module
Testing If A VBComponent Exists
This code will return True or False indicating whether the VBComponent named by VBCompName exists in the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used.
Public Function VBComponentExists(ByVal VBCompName As String, _
Optional ByVal VBProj As VBIDE.VBProject = Nothing) As Boolean
Dim VBP As VBIDE.VBProject
If VBProj Is Nothing Then
Set VBP = ActiveWorkbook.VBProject
Else
Set VBP = VBProj
End If
On Error Resume Next
VBComponentExists = CBool(Len(VBP.VBComponents(VBCompName).Name))
End Function
Total Code Lines In A Component
This function will return the total code lines in a VBComponent.
It ignores blank lines and comment lines. It will return -1 if the project is locked.
Public Function TotalCodeLinesInVBComponent(ByVal VBComp As VBIDE.VBComponent) As Long
Dim N As Long
Dim S As String
Dim LineCount As Long
If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
TotalCodeLinesInVBComponent = -1
Exit Function
End If
With VBComp.CodeModule
For N = 1 To .CountOfLines
S = .Lines(N, 1)
If Trim(S) = vbNullString Then
' blank line, skip it
ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
Else
LineCount = LineCount + 1
End If
Next N
End With
TotalCodeLinesInVBComponent = LineCount
End Function
Total Lines In A Project
This code will return the count of lines in all components of the project referenced by VBProj.
If VBProj is omitted, the VBProject of the ActiveWorkbook is used. The function will return -1 if the project is locked.
Public Function TotalLinesInProject(Optional VBProj As VBIDE.VBProject = Nothing) As Long
Dim VBP As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim LineCount As Long
If VBProj Is Nothing Then
Set VBP = ActiveWorkbook.VBProject
Else
Set VBP = VBProj
End If
If VBP.Protection = vbext_pp_locked Then
TotalLinesInProject = -1
Exit Function
End If
For Each VBComp In VBP.VBComponents
LineCount = LineCount + VBComp.CodeModule.CountOfLines
Next VBComp
TotalLinesInProject = LineCount
End Function
Total Code Lines In A Component
This function will return the total number of code lines in a VBComponent.
It ignores blank lines and comment lines. It will return -1 if the project is locked.
Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long
Dim N As Long
Dim S As String
Dim LineCount As Long
If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
TotalCodeLinesInVBComponent = -1
Exit Function
End If
With VBComp.CodeModule
For N = 1 To .CountOfLines
S = .Lines(N, 1)
If Trim(S) = vbNullString Then
' blank line, skip it
ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
Else
LineCount = LineCount + 1
End If
Next N
End With
TotalCodeLinesInVBComponent = LineCount
End Function
Total Code Lines In A Project
This function will return the total number of code lines in all the components of a VBProject.
It ignores blank lines and comment lines. It will return -1 if the project is locked.
Public Function TotalCodeLinesInProject(ByVal VBProj As VBIDE.VBProject) As Long
Dim VBComp As VBIDE.VBComponent
Dim LineCount As Long
If VBProj.Protection = vbext_pp_locked Then
TotalCodeLinesInProject = -1
Exit Function
End If
For Each VBComp In VBProj.VBComponents
LineCount = LineCount + TotalCodeLinesInVBComponent(VBComp)
Next VBComp
TotalCodeLinesInProject = LineCount
End Function
Procnames Function
Function to return the names of Procedures in a given module
Public Function ProcNames(ByVal sModuleName As String) As String()
Dim lngSLine As Long
Dim vbCodeMod As CodeModule
Dim intPCount As Integer
Dim pnamearray() As String
Set vbCodeMod = ThisWorkbook.VBProject.VBComponents(sModuleName).CodeModule
With vbCodeMod
lngSLine = .CountOfDeclarationLines + 1
Do Until lngSLine >= .CountOfLines
intPCount = intPCount + 1
ReDim Preserve pnamearray(intPCount)
pnamearray(intPCount) = .ProcOfLine(lngSLine, vbext_pk_Proc)
lngSLine = lngSLine + .ProcCountLines(.ProcOfLine(lngSLine, vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
ProcNames = pnamearray()
End Function
ModExist Function
This function test to see if a given VBA module exists in the current project.
Public Function ModExist(ByVal sModuleName As String) As Boolean
Dim intVBCcnt As Integer
Dim intVBDcnt As Integer
Dim intLC1 As Integer
intVBCcnt = ThisWorkbook.VBProject.VBComponents.Count
intVBDcnt = 0
For intLC1 = 1 To intVBCcnt
If ThisWorkbook.VBProject.VBComponents(intLC1).Type = vbext_ct_StdModule Then
If ThisWorkbook.VBProject.VBComponents(intLC1).Name = sModuleName Then
ModExist = True
GoTo Exit_ModExist
End If
End If
Next intLC1
ModExist = False
Exit_ModExist:
End Function
Really Bad Code
This code has not been validated - please don't use
Copy A Module From One Project To Another
There is no direct way to copy a module from one project to another.
To accomplish this task, you must export the module from the Source VBProject and then import that file into the Destination VBProject.
The code below will do this. The function declaration is:
Function CopyModule(ModuleName As String, _
FromVBProject As VBIDE.VBProject, _
ToVBProject As VBIDE.VBProject, _
OverwriteExisting As Boolean) As Boolean
ModuleName is the name of the module you want to copy from one project to another.
FromVBProject is the VBProject that contains the module to be copied. This is the source VBProject.
ToVBProject is the VBProject in to which the module is to be copied. This is the destination VBProject.
OverwriteExisting indicates what to do if ModuleName already exists in the ToVBProject. If this is True the existing VBComponent will be removed from the ToVBProject.
If this is False and the VBComponent already exists, the function does nothing and returns False.
The function returns True if successful or False is an error occurs. The function will return False if any of the following are true:
FromVBProject is nothing.
ToVBProject is nothing.
ModuleName is blank.
FromVBProject is locked.
ToVBProject is locked.
ModuleName does not exist in FromVBProject.
ModuleName exists in ToVBProject and OverwriteExisting is False.
Function CopyModule(ModuleName As String, _
FromVBProject As VBIDE.VBProject, _
ToVBProject As VBIDE.VBProject, _
OverwriteExisting As Boolean) As Boolean
Dim VBComp As VBIDE.VBComponent
Dim FName As String
If FromVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If Trim(ModuleName) = vbNullString Then
CopyModule = False
Exit Function
End If
If ToVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If FromVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
If ToVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
On Error Resume Next
Set VBComp = FromVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
End If
With ToVBProject.VBComponents
.Remove .Item(ModuleName)
End With
Else
Err.Clear
Set VBComp = ToVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
If Err.Number = 9 Then
' module doesn't exist. ignore error.
Else
' other error. get out with return value of False
CopyModule = False
Exit Function
End If
End If
End If
FromVBProject.VBComponents(ModuleName).Export Filename:=FName
ToVBProject.VBComponents.Import Filename:=FName
Kill FName
CopyModule = True
End Function
Eliminating Screen Flicker During VBProject Code
When you used the Extensibility code, the VBA Editor window will flicker. This can be reduced with the code:
Application.VBE.MainWindow.Visible = False
This will hide the VBE window, but you may still see it flicker. To prevent this, you must use the LockWindowUpdate Windows API function.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long
Sub EliminateScreenFlicker()
Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If
'''''''''''''''''''''''''
' your code here
'''''''''''''''''''''''''
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub
General Infomation About A Procedure
The code below returns the following information about a procedure in a module, loaded into the ProcInfo Type.
The function ProcedureInfo takes as input then name of the procedure, a VBIDE.vbext_ProcKind procedure type, and a reference to the CodeModule object containing the procedure.
Public Enum ProcScope
ScopePrivate = 1
ScopePublic = 2
ScopeFriend = 3
ScopeDefault = 4
End Enum
Public Enum LineSplits
LineSplitRemove = 0
LineSplitKeep = 1
LineSplitConvert = 2
End Enum
Public Type ProcInfo
ProcName As String
ProcKind As VBIDE.vbext_ProcKind
ProcStartLine As Long
ProcBodyLine As Long
ProcCountLines As Long
ProcScope As ProcScope
ProcDeclaration As String
End Type
Function ProcedureInfo(ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _
CodeMod As VBIDE.CodeModule) As ProcInfo
Dim PInfo As ProcInfo
Dim BodyLine As Long
Dim Declaration As String
Dim FirstLine As String
BodyLine = CodeMod.ProcStartLine(ProcName, ProcKind)
If BodyLine > 0 Then
With CodeMod
PInfo.ProcName = ProcName
PInfo.ProcKind = ProcKind
PInfo.ProcBodyLine = .ProcBodyLine(ProcName, ProcKind)
PInfo.ProcCountLines = .ProcCountLines(ProcName, ProcKind)
PInfo.ProcStartLine = .ProcStartLine(ProcName, ProcKind)
FirstLine = .Lines(PInfo.ProcBodyLine, 1)
If StrComp(Left(FirstLine, Len("Public")), "Public", vbBinaryCompare) = 0 Then
PInfo.ProcScope = ScopePublic
ElseIf StrComp(Left(FirstLine, Len("Private")), "Private", vbBinaryCompare) = 0 Then
PInfo.ProcScope = ScopePrivate
ElseIf StrComp(Left(FirstLine, Len("Friend")), "Friend", vbBinaryCompare) = 0 Then
PInfo.ProcScope = ScopeFriend
Else
PInfo.ProcScope = ScopeDefault
End If
PInfo.ProcDeclaration = GetProcedureDeclaration(CodeMod, ProcName, ProcKind, LineSplitKeep)
End With
End If
ProcedureInfo = PInfo
End Function
Public Function GetProcedureDeclaration(CodeMod As VBIDE.CodeModule, _
ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _
Optional LineSplitBehavior As LineSplits = LineSplitRemove)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetProcedureDeclaration
' This return the procedure declaration of ProcName in CodeMod. The LineSplitBehavior
' determines what to do with procedure declaration that span more than one line using
' the "_" line continuation character. If LineSplitBehavior is LineSplitRemove, the
' entire procedure declaration is converted to a single line of text. If
' LineSplitBehavior is LineSplitKeep the "_" characters are retained and the
' declaration is split with vbNewLine into multiple lines. If LineSplitBehavior is
' LineSplitConvert, the "_" characters are removed and replaced with vbNewLine.
' The function returns vbNullString if the procedure could not be found.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LineNum As Long
Dim S As String
Dim Declaration As String
On Error Resume Next
LineNum = CodeMod.ProcBodyLine(ProcName, ProcKind)
If Err.Number <> 0 Then
Exit Function
End If
S = CodeMod.Lines(LineNum, 1)
Do While Right(S, 1) = "_"
Select Case True
Case LineSplitBehavior = LineSplitConvert
S = Left(S, Len(S) - 1) & vbNewLine
Case LineSplitBehavior = LineSplitKeep
S = S & vbNewLine
Case LineSplitBehavior = LineSplitRemove
S = Left(S, Len(S) - 1) & " "
End Select
Declaration = Declaration & S
LineNum = LineNum + 1
S = CodeMod.Lines(LineNum, 1)
Loop
Declaration = SingleSpace(Declaration & S)
GetProcedureDeclaration = Declaration
End Function
Private Function SingleSpace(ByVal Text As String) As String
Dim Pos As String
Pos = InStr(1, Text, Space(2), vbBinaryCompare)
Do Until Pos = 0
Text = Replace(Text, Space(2), Space(1))
Pos = InStr(1, Text, Space(2), vbBinaryCompare)
Loop
SingleSpace = Text
End Function
You can call the ProcedureInfo function using code like the following:
Sub ShowProcedureInfo()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim CompName As String
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Dim PInfo As ProcInfo
CompName = "modVBECode"
ProcName = "ProcedureInfo"
ProcKind = vbext_pk_Proc
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(CompName)
Set CodeMod = VBComp.CodeModule
PInfo = ProcedureInfo(ProcName, ProcKind, CodeMod)
Debug.Print "ProcName: " & PInfo.ProcName
Debug.Print "ProcKind: " & CStr(PInfo.ProcKind)
Debug.Print "ProcStartLine: " & CStr(PInfo.ProcStartLine)
Debug.Print "ProcBodyLine: " & CStr(PInfo.ProcBodyLine)
Debug.Print "ProcCountLines: " & CStr(PInfo.ProcCountLines)
Debug.Print "ProcScope: " & CStr(PInfo.ProcScope)
Debug.Print "ProcDeclaration: " & PInfo.ProcDeclaration
End Sub
Find the name of a VBComponent that contains a specified procedure
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
For Each oVBC In oBk.VBProject.VBComponents
With oVBC.CodeModule
If .Find(sUniqueString, 1, 1, .CountOfLines, 1000, True, _
True, False) Then
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
For Each oVBC In oBk.VBProject.VBComponents
With oVBC.CodeModule
If .Find(sUniqueString, lStart, 1, .CountOfLines, 1000, True, _
True, False) Then
vaProcs = Array(vbext_pk_Proc, vbext_pk_Get, vbext_pk_Let, _
vbext_pk_Set)
For Each vProcType In vaProcs
sProcName = .ProcOfLine(lStart, CLng(vProcType))
If sProcName <> "" Then
fnThisProcedureName = sProcName
Exit For
End If
Next
Exit For
End If
End With
Next
End Function
This procedure contains VBA code to add to your existing VBA code --
basically, it puts one statement at the beginning of each procedure in every
module (class modules and event procedures not included). This statement is
a call to a routine (which YOU need to write) and passes the sub/function
name. For example...
Before:
Sub ABC()
Dim i as Integer
For each x in sheets
Next
End Sub
Sub xyz()
End Sub
After:
Sub ABC()
MyProc "ABC"
Dim i as Integer
For each x in sheets
Next
End Sub
Sub xyz()
MyProc "xyz"
End Sub
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited TopPrevNext