Programming The VBA Editor
This page describes how to write code that modifies or reads other VBA code.
You can write code in VBA that reads or modifies other VBA projects, modules, or procedures. This is called
extensibility because extends the editor -- you can use VBA code to create new VBA code.
You can use these features to write custom procedures that create, change, or delete VBA modules and code
procedures.
In order to use the code on this page in your projects, you must change two settings.
- First, you need to set an reference to the VBA Extensibility library. The library contains the definitions
of the objects that make up the VBProject. In the VBA editor, go the the Tools menu and choose References. In that
dialog, scroll down to and check the entry for Microsoft Visual Basic For Applications Extensibility 5.3. If you do
not set this reference, you will receive a User-defined type not defined compiler error.
- Next, you need to enable programmatic access to the VBA Project. In Excel 2003 and earlier, go the Tools menu
(in Excel, not in the VBA editor), choose Macros and then the Security item. In that dialog, click on the
Trusted Publishers tab and check the Trust access to the Visual Basic Project setting.
In Excel 2007, click the Developer item on the main Ribbon and then click the Macro Security item in
the Code panel. In that dialog, choose Macro Settings and check the Trust access to the VBA project
object model.
The VBA Project that you are going to change with these procedures must be unlocked. There is no programmatic way to
unlock a VBA project (other than using
SendKeys). If the project is locked, you must manually
unlock. Otherwise, the procedures will not work.
CAUTION: Many VBA-based computer viruses propagate themselves by creating and/or modifying VBA code. Therefore, many virus
scanners may automatically and without warning or confirmation delete modules that reference the VBProject object, causing
a permanent and irretrievable loss of code. Consult the documentation for your anti-virus software for details.
For information about using creating custom menu items in the Visual Basic Editor, see Menus In The
VBA Editor.
Adding A Module To A Project
Adding A Procedure To A Module
Copy A Module From One Project To Another
Creating A New Procedure In A Code Module
Creating An Event Procedure
Deleting A Module From A Project
Deleting A Procedure From A Module
Deleting All VBA Code In A Project
Eliminating Screen Flicker When Working With The Visual Basic Editor
Exporting A VBComponent To A Text File
Listing All Procedures In A Module
Reading A Procedure Declaration
Renaming A Module
Searching A Module For Text
Testing If A VBCompoent Exists
Total Code Lines In A Component
Total Code Lines In A Project
Total Lines In A Project
Workbook Associated With A VBProject
The following is a list of the more common objects that are used in the VBA Extensibilty object model. This is not
a comprehensive list, but will be sufficient for the tasks at hand.
VBIDE
The VBIDE is the object library that defines all the objects and values that make up VBProject and the
Visual Basic Editor. You must reference this library to use the VBA Extensibility objects. To add this
reference, open the VBA editor, open your VBProject in the editor, and go to the Tools menu. There, choose References
. In the References dialog, scroll down to Microsoft Visual Basic for Applications Extensibility 5.3 and
check that item in the list. You can add the reference programmatically with code like:
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
VBE
The
VBE refers to the Visual Basic Editor, which includes all the windows and projects that make up the
editor.
VBProject
A
VBProject contains all the code modules and components of a single workbook. One workbook has exactly one
VBProject. The
VBProject is made up of 1 or more
VBComponent objects.
VBComponent
A
VBComponent is one object within the
VBProject. A
VBComponent is a regular code module, a UserForm, a class module, any one of the Sheet modules, or the ThisWorkbook
module (together, the Sheet modules and the ThisWorkbook module are called
Document Type modules). A
VBComponent is of one of the following types, identified by the
Type
property. The following constants are used to identify the
Type. The numeric value of each constant
is shown in parentheses.
- vbext_ct_ClassModule (2): A class module to create your own objects. See
Class Modules for details about classes and objects.
- vbext_ct_Document (100): One of the Sheet modules or the ThisWorkbook
module.
- vbext_ct_MSForm (3): A UserForm. The visual component of a UserForm in the VBA
Editor is called a Designer.
- vbext_ct_StdModule (1): A regular code module. Most of the procedures on this
page will work with these types of components.
CodeModule
A
CodeModule is the VBA source code of a VBComponent. You use the
CodeModule
object to access the code associated with a
VBComponent. A
VBComponent has
exactly one
CodeModule which contains all the code for that component.
CodePane
A
CodePane is an open editing window of a
CodeModule. When you are typing code,
you are entering code into the CodePane.
The code below illustrate various ways to reference Extensibility objects.
Dim VBAEditor As VBIDE.VBE
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBAEditor = Application.VBE
Set VBProj = VBAEditor.ActiveVBProject
Set VBProj = Application.Workbooks("Book1.xls").VBProject
Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module1")
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
Set CodeMod = VBComp.CodeModule
In the code and descriptions on this page, the term Procedure means a Sub,
Function, Property Get, Property Let,
or Property Set procedure. The Extensibility library defines four procedures types, identified
by the following constants. The numeric value of each constant is shown within parentheses.
- vbext_pk_Get (3). A Property Get procedure.
- vbext_pk_Let (1). A Property Let procedure.
- vbext_pk_Set (2). A Property Set procedure.
- vbext_pk_Proc (0). A Sub or Function procedure.
The rest of this page describes various procedures that modify the various objects of a VBProject.
The VBA editor is said to be "in sync" if the ActiveVBProject is the same as the
VBProject that contains the ActiveCodePane. If you have two or more projects open
within the VBA editor, it is possible to have an active code pane open from Project1 and have a component of Project2
selected in the Project Explorer window. In this case, the Application.VBE.ActiveVBProject is the project
that is selected in the Project window, while Application.VBE.ActiveCodePane is a different project,
specifically the project referenced by Application.VBE.ActiveCodePane.CodeModule.Parent.Collection.Parent.
You can test whether the editor in in sync with code like the following.
Function IsEditorInSync() As Boolean
With Application.VBE
IsEditorInSync = .ActiveVBProject Is _
.ActiveCodePane.CodeModule.Parent.Collection.Parent
End With
End Function
You can force synchronization with code like the following. This will set the
ActiveVBProject to the project associated with the
ActiveCodePane.
Sub SyncVBAEditor()
With Application.VBE
If Not .ActiveCodePane Is Nothing Then
Set .ActiveVBProject = .ActiveCodePane.CodeModule.Parent.Collection.Parent
End If
End With
End Sub
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.
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
Creating a procedure via VBA code is really quite simple. Build up a text string of the code, using vbCrLf to
create new lines, and then insert that text with the InsertLines method, passing to it the line number
and the text string. The following code will add a simple "Hello World" procedure named SayHello to the end of the module named
Module1.
Sub AddProcedureToModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """"
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
You can also build up a String variable with the content of the procedure and insert that string with one call to InsertLines. For example,
Dim CodePan As VBIDE.CodeModule
Dim S As String
Set CodePan = ThisWorkbook.VBProject.VBComponents("Module2").CodeModule
S = _
"Sub ABC()" & vbNewLine & _
" MsgBox ""Hello World"",vbOkOnly" & vbNewLine & _
"End Sub" & vbNewLine
With CodePan
.InsertLines .CountOfLines + 1, S
End With
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.
The complete code is shown below:
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
Dim CompName As String
Dim S As String
Dim SlashPos As Long
Dim ExtPos As Long
Dim TempVBComp As VBIDE.VBComponent
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
SlashPos = InStrRev(FName, "\")
ExtPos = InStrRev(FName, ".")
CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
Set VBComp = Nothing
Set VBComp = ToVBProject.VBComponents(CompName)
If VBComp Is Nothing Then
ToVBProject.VBComponents.Import Filename:=FName
Else
If VBComp.Type = vbext_ct_Document Then
' VBComp is destination module
Set TempVBComp = ToVBProject.VBComponents.Import(FName)
' TempVBComp is source module
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
.InsertLines 1, S
End With
On Error GoTo 0
ToVBProject.VBComponents.Remove TempVBComp
End If
End If
Kill FName
CopyModule = True
End Function
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.
CreateEventProc will create the declaration line and the end of procedure line. It returns the line number
on which the event procedure begins.
Sub CreateEventProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """"
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
You can use code to create code in a module. The code
below creates a simple "Hello World" Sub procedure. You can either create a new
VBComponent to hold the procedure or you can use an existing module. Comment out
the appropriate lines of code.
Sub CreateProcedure()
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim S As String
Dim LineNum As Long
'Set VBComp = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
'VBComp.Name = "NewModule"
'Set VBComp = ThisWorkbook.VBProject.VBComponents("Module2")
Set CodeMod = VBComp.CodeModule
LineNum = CodeMod.CountOfLines + 1
S = "Sub HelloWorld()" & vbCrLf & _
" MsgBox ""Hello, World""" & vbCrLf & _
"End Sub"
CodeMod.InsertLines LineNum, S
End Sub
This code creates the procedure:
Sub HelloWorld()
MsgBox "Hello, World"
End Sub
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.
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
You can manually rename a module by displaying the Properties window (press F4) for the module and changing the Name property. You can
do this programmatically with
ActiveWorkbook.VBProject.VBComponents("OldName").Name = "NewName"
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.
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
This code will delete ALL VBA code in a VBProject.
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
With CodeMod
.DeleteLines 1, .CountOfLines
End With
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
End Sub
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
You can export an existing VBComponent CodeModule to a text file. 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(VBComp As VBIDE.VBComponent, _
FolderName As String, _
Optional FileName As String, _
Optional 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(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
This code will list all the modules and their types in the workbook, starting the listing in cell A1.
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
Function ComponentTypeToString(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
This code will list all the procedures in Module1, beginning the listing in cell A1.
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
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)
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
The CodeModule object has a Find method that you can use to search for
text within the code module. The Find method accepts ByRef Long parameters. Upon
input, these parameters specify the range of lines and column to search. On output, these values will point to the found text. To find
the second and subsequent occurence of the text, you need to set the parameters to refer to the text following the found line and
column. The Find method returns True or False indicating
whether the text was found. The code below will search all of the code in Module1 and print a
Debug message for each found occurrence. Note the values set with the SL,
SC, EL, and EC variables. The code loops until
the Found variable is False.
Sub SearchCodeModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim FindWhat As String
Dim SL As Long
Dim EL As Long
Dim SC As Long
Dim EC As Long
Dim Found As Boolean
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
FindWhat = "findthis"
With CodeMod
SL = 1
EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=False, patternsearch:=False)
Do Until Found = False
Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
EL = .CountOfLines
SC = EC + 1
EC = 255
Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=False, patternsearch:=False)
Loop
End With
End Sub
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(VBCompName As String, Optional 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
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(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
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the total number of lines in all components of the VBProject
' referenced by VBProj. If VBProj is missing, the VBProject of the ActiveWorkbook
' is used. Returns -1 if the VBProject is locked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
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
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(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
The Workbook object provides a property named VBProject that allows you to
reference to the VBProject associated with a workbook. However, the reverse is not true. There is
no direct way to get a reference to the workbook that contains a specific VBProject. However, it
can be done with some fairly simple code. The following function, WorkbookOfVBProject,
will return a reference to the Workbook object that contains the VBProject indicated by the
WhichVBP parameter. This parameter may be a VBIDE.VBProject
object, or a string containing the name of the VBProject (the project name, not the workbook name), or a
numeric index, indicating the ordinal index of the VBProject (its position in the list of VBProjects in
the Project Explorer window). If the
parameter is any object other than VBIDE.VBProject, the code raises an
error 13 (type mismatch). If the parameter does not name an existing VBProject, the code raises
an error 9 (subscript out of range). If you have more than one VBProject with the default name
VBAProject, the code will return the first VBProject with that name.
Dim WB As Workbook
Dim AI As AddIn
Dim VBP As VBIDE.VBProject
If IsObject(WhichVBP) = True Then
On Error GoTo 0
If TypeOf WhichVBP Is VBIDE.VBProject Then
Set VBP = WhichVBP
Else
Err.Raise 13
End If
Else
On Error Resume Next
Err.Clear
Set VBP = Application.VBE.VBProjects(WhichVBP)
On Error GoTo 0
If VBP Is Nothing Then
Err.Raise 9
End If
End If
For Each WB In Workbooks
If WB.VBProject Is VBP Then
Set WorkbookOfVBProject = WB
Exit Function
End If
Next WB
For Each AI In Application.AddIns
If AI.Installed = True Then
If Workbooks(AI.Name).VBProject Is VBP Then
Set WorkbookOfVBProject = Workbooks(AI.Name)
Exit Function
End If
End If
Next AI
End Function
 |
This page last updated: 15-July-2010. |