Introduction

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 used 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 Extensibililty 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.

Operations Described On This Page

Adding A Module To A Project
Adding A Procedure To A
Module
Copy A Module From One Project To Another
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
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

Objects In The VBA Extensibility
Model

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 code module, a UserForm, a class module, 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.

CodePane
A CodePane is an open
editing window of a CodeModule.

Referencing VBIDE Objects

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
' or
Set VBProj = Application.Workbooks("Book1.xls").VBProject
'''''''''''''''''''''''''''''''''''''''''''
Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module1")
' or
Set VBComp = VBProj.VBComponents("Module1")
'''''''''''''''''''''''''''''''''''''''''''
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
' or
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.

Ensuring The Editor In
Synchronized

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
'=======================================================================
' IsEditorInSync
' This tests if the VBProject selected in the Project window, and
' therefore the ActiveVBProject is the same as the VBProject associated
' with the ActiveCodePane. If these two VBProjects are the same,
' the editor is in sync and the result is True. If these are not the
' same project, the editor is out of sync and the result is True.
'=======================================================================
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()
'=======================================================================
' SyncVBAEditor
' This syncs the editor with respect to the ActiveVBProject and the
' VBProject containing the ActiveCodePane. This makes the project
' that conrains the ActiveCodePane the ActiveVBProject.
'=======================================================================
With Application.VBE
If Not .ActiveCodePane Is Nothing Then
Set .ActiveVBProject = .ActiveCodePane.CodeModule.Parent.Collection.Parent
End If
End With
End Sub

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.

    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.

    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

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.

The complete code is shown below:

Function CopyModule(ModuleName As String, _
FromVBProject As VBIDE.VBProject, _
ToVBProject As VBIDE.VBProject, _
OverwriteExisting As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CopyModule
' This function copies a module from one VBProject to
' another. It returns True if successful or False
' if an error occurs.
'
' Parameters:
' --------------------------------
' FromVBProject The VBProject that contains the module
' to be copied.
'
' ToVBProject The VBProject into which the module is
' to be copied.
'
' ModuleName The name of the module to copy.
'
' OverwriteExisting If True, the VBComponent named ModuleName
' in ToVBProject will be removed before
' importing the module. If False and
' a VBComponent named ModuleName exists
' in ToVBProject, the code will return
' False.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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 '''''''''''''''''''''''''''''''''''''''''''''
' Do some housekeeping validation.
'''''''''''''''''''''''''''''''''''''''''''''
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 is the name of the temporary file to be
' used in the Export/Import code.
''''''''''''''''''''''''''''''''''''''''''''''''''''
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
''''''''''''''''''''''''''''''''''''''
' If OverwriteExisting is True, Kill
' the existing temp file and remove
' the existing VBComponent from the
' ToVBProject.
''''''''''''''''''''''''''''''''''''''
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
'''''''''''''''''''''''''''''''''''''''''
' OverwriteExisting is False. If there is
' already a VBComponent named ModuleName,
' exit with a return code of False.
''''''''''''''''''''''''''''''''''''''''''
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 ''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the Export and Import operation using FName
' and then Kill FName.
''''''''''''''''''''''''''''''''''''''''''''''''''''
FromVBProject.VBComponents(ModuleName).Export Filename:=FName '''''''''''''''''''''''''''''''''''''
' Extract the module name from the
' export file name.
'''''''''''''''''''''''''''''''''''''
SlashPos = InStrRev(FName, "\")
ExtPos = InStrRev(FName, ".")
CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1) ''''''''''''''''''''''''''''''''''''''''''''''
' Document modules (SheetX and ThisWorkbook)
' cannot be removed. So, if we are working with
' a document object, delete all code in that
' component and add the lines of FName
' back in to the module.
''''''''''''''''''''''''''''''''''''''''''''''
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

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. 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 = """" ' 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.

    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.

    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.

    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

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

Exporting A VBComponent Code Module To A Text File

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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function exports the code module of a VBComponent 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.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the appropriate file extension based on the Type of
' the VBComponent.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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.

    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

Listing All Procedures In A Module

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

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

Searching For Text In A Module

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 ' start line
Dim EL As Long ' end line
Dim SC As Long ' start column
Dim EC As Long ' end column
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

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(VBCompName As String, Optional VBProj As VBIDE.VBProject = Nothing) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns True or False indicating whether a VBComponent named
' VBCompName exists in the VBProject referenced by VBProj. If VBProj
' is omitted, the VBProject of the ActiveWorkbook is used.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 Code Module

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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the total number of code lines (excluding blank lines and
' comment lines) in the VBComponent referenced by VBComp. Returns -1
' if the VBProject is locked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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

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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the total number of code lines (excluding blank lines and
' comment lines) in the VBComponent referenced by VBComp. Returns -1
' if the VBProject is locked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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(VBProj As VBIDE.VBProject) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the total number of code lines (excluding blank lines and
' comment lines) in all VBComponents of VBProj. Returns -1 if VBProj
' is locked.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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

Workbook Associated With A VBProject

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.

Function WorkbookOfVBProject(WhichVBP As Variant) As Workbook
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WorkbookOfVBProject
' This returns the Workbook object for a specified VBIDE.VBProject.
' The parameter WhichVBP can be any of the following:
' A VBIDE.VBProject object
' A string containing the name of the VBProject.
' The index number (ordinal position in Project window) of the VBProject.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim WB As Workbook
Dim AI As AddIn
Dim VBP As VBIDE.VBProject If IsObject(WhichVBP) = True Then
' If WhichVBP is an object, it must be of the
' type VBIDE.VBProject. Any other object type
' throws an error 13 (type mismatch).
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
' Here, WhichVBP is either the string name of
' the VBP or its ordinal index number.
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
' not found in workbooks, search installed add-ins.
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

VBA 操作 VBE的更多相关文章

  1. Excel VBA 操作 Word(入门篇)

    原文地址 本文的对象是:有一定Excel VBA基础,对Word VBA还没有什么认识,想在Excel中通过VBA操作Word还有困难的人.   一.新建Word引用 需要首先创建一个对 Word A ...

  2. VBA 操作数字

    第8章 操作数字 加.减.乘.除.平方与指数(^2 或者^n).平方根Sqr.正弦Sin.余弦Cos.正切Tan.反正切Atn.绝对值Abs 转换为整型数.长整型数.双精度型数和值 Cint当双精度型 ...

  3. VBA操作word生成sql语句

    项目开始一般都是用word保存下数据库的文档 但是从表单一个一个的建表实在是很困难乏味,查查资料 1.可以生成一个html或者xml,检索结构生成sql.但是这个方式也蛮麻烦 2.查到vba可以操作w ...

  4. MicroStation VBA 操作提示

    Sub TestShowCommand() ShowCommand "画条线" ShowPrompt "选择第一个点" ShowStatus "选择第 ...

  5. VBA 操作 Excel 生成日期及星期

    直接上代码~~ 1.  在一个 Excel 生成当月或当年指定月份的日期及星期 ' 获取星期的显示 Function disp(i As Integer) Select Case i disp = & ...

  6. C# vba 操作 Word

    添加引用 Microsoft Word  *.0 Object Library Microsoft Graph *.0 Object Library 变量说明 Object oMissing = Sy ...

  7. 关于Visio的vba操作,遍历目录,对所有vsd文件操作,导入excel文件

    1.vba遍历要添加引用,runtime 2.不能打开单独的application,因为在获取到shape的picture属性时候,新打开的application不能够获取到.提示自动化错误. 3.定 ...

  8. 工作需求——VBA操作打印机

    因为最近做的事情比较多,平时也多用EXCEL,所以顺便学习EXCEL的功能性的东西 转载:https://msdn.microsoft.com/zh-tw/vba/excel-vba/articles ...

  9. Excel 关于新建xls文件 新建sheet 合并sheet的VBA操作代码

    Sub 合并一个文件夹下全部xls文件中sheet到一个xls的sheet()workDir = ThisWorkbook.Path '当前xls文件所在的目录绝对路径'MsgBox workDir, ...

随机推荐

  1. Array.prototype.slice.call(arguments)探究

    Array.prototype.slice.call(arguments)能将具有length属性的对象转成数组 首先,slice有两个用法,一个是String.slice,一个是Array.slic ...

  2. 如何查看Eclipse的数字版的版本(转)

    为什么叫数字版的版本,因为Eclipse软件里显示的是文字版的版本,比如我现在的就是Version: Indigo Release.这在下载插件的时候很不方便. 如何查看文字版的版本信息:打开Ecli ...

  3. aircrack-ng 工具集学习

    一.aircrack-ng简介 aircrack-ng是Aircrack项目的一个分支.是一个与802.11标准的无线网络分析有关的安全软件,主要功能有:网络侦测,数据包嗅探,WEP和WPA/WPA2 ...

  4. solr学习三(测试类,含普通与ExtractingRequestHandler测试)

    solr客户端基本是配置出来的,服务端可以对其进行测试,我使用的是solrj服务端. 如果初学solr,先使用普通的测试类: import java.io.IOException; import ja ...

  5. spring 概念之:IoC(控制反转)

    IoC(控制反转,Inverse of Control) IoC 的字面意思是控制反转,它包括两方面的内容: 控制 反转 那到底是什么东西的"控制"被"反转"了 ...

  6. button使用注意

    <button type="button" class="btn btn-primary" onclick="ChangePassword(); ...

  7. 大数据学习资料之SQL与NOSQL数据库

    这几年的大数据热潮带动了一激活了一大批hadoop学习爱好者.有自学hadoop的,有报名培训班学习的.所有接触过hadoop的人都知道,单独搭建hadoop里每个组建都需要运行环境.修改配置文件测试 ...

  8. Openwrt编译时修改默认IP的方法

    在~/openwrt/barrier_breaker/package/base-files/files/lib/functions/ uci-defaults.sh 第178行修改IP地址

  9. 【jmeter】jmeter测试手机app的服务器压力

    具体步骤: 1.电脑启动jmeter 2.jmeter在测试计划新建线程组. 3.在工作台新建http代理服务器 4.配置HTTP代理服务器 5.设置IE代理到本地 6.手机wifi设置代理连接到PC ...

  10. linux 信号处理 二 (信号的默认处理)

    今天碰到一个SIGHUP问题,再复习一遍: 有些信号的默认处理方式为“终止+core”,这里的core表示,进程终止时,会在进程的当前工作目录生产一个core文件,该文件是进程终止时的内存快照,以便以 ...