Programming To The Visual Basic Editor 

This page has been replaced. You will be redirected to the new page.

Visual Basic Editor (VBE) is the tool used to create, modify, and maintain Visual Basic For Applications (VBA) procedures and modules in MS Office applications.   VBA gives you the ability to modify workbooks and worksheets through VBA, as if you were going through the Excel interface.  VBA also allows you to modify VBA components and code modules, as if you were going through the VBE interface.    This page applies only to Excel97 and above.  It does not apply to Excel95 or previous versions. 

This pages describes a few of the objects, methods, and properties of the VBE that you can manipulate from VBA.  In Excel97, these objects, methods, and properties are not described in the normal VBA help files.  You need to open the file called VEENOB3.hlp.  This file many not have been installed on your system when you installed the VBA help files and Office97.  You can find it in the MoreHelp folder on your Excel or Office CD.  You many want to have a macro, assigned to a menu item or a shortcut key to easily display this file.

Sub ShowVBEHelp()
    Shell "c:\windows\winhelp.exe veenob3.hlp", vbNormalFocus
End Sub

In Excel 2000 later, these topics are included in the standard VBA help files. 

Sections On This Page
Introduction
Adding A Module To A Project
Adding A Procedure To A Module
Copying Modules Between Projects
Creating An Event Procedure
Deleting A Module From A Project
Deleting A Procedure From A Module
Deleting All Code In A Module
Delete All VBA Code In A Project
Eliminating Screen Flickering
Exporting All Modules In A Project
Getting A Procedure's Declaration
Listing All Modules In A Project
Listing All Procedures In A Module
Listing All Procedures In A Project
Objects In The Extensibility Model

 

Before using these procedures, you'll need to set a reference in VBA to the VBA Extensibility library.  In the VBA editor, go to the Tools menu, choose the References item, and put a check next to "Microsoft Visual Basic For Applications Extensibility" library.   This enables VBA to find the definitions of these objects.  If you are using Excel97, this library will appear in the References list without a version number:  "Microsoft Visual Basic For Applications Extensibility".  If you are using Excel 2000 or later, it will appear with a version number: "Microsoft Visual Basic For Applications Extensibility 5.3".  It is very important that you reference the proper library.  If you reference the wrong library, you will receive "Type Mismatch" errors.  If you don't reference the extensibility library at all, you will receive "User Defined Type Not Defined Error" messages.

For  information about programming the menus in the VBE, see the Adding Menus To The VBA Editor page.

Note: An additional level of security was added in Excel 2002.  To manipulate the VBA Project objects as described here, you'll have to change your security setting.  Go to the Tools menu, choose Macros, then Security. Click the "Trusted Sources" tab, and put a check next to the "Trust access to Visual Basic Project".

NOTE: In all versions of Excel, the VBProject must not be protected.  If it is, these procedures will fail. There is no programmatic way to unlock a locked project.  In Excel 2002 and later, you must have "Trust Access To Visual Basic Project" enabled.  To enable this setting, go to the Tools menu in Excel, choose Macros, Security, then the "Trusted Sources" tab, and put a check next to "Trust Access To Visual Basic Project".  Otherwise, you will get errors.

Also, you may get unpredictable results if you attempt to modify a code module's code from that same module.  That is, having code in Module1 modify the contents of Module1.  I recommend that you do not do this.

NOTE: Many macro-based viruses propagate themselves by writing code using the methods described on this page. Therefore, many if not all virus scanning programs will automatically delete code that manipulates VBA code.  Some programs will delete the entire code module. You may want to turn off your virus scanner when working with workbooks that manipulate VBA code projects.
 

VBE Objects

We'll be using three of these objects in our code: 

VBProject                This is the entire set of VBA modules and references associated with a workbook. 

VBComponent       This is the individual component within a VBProject.  For example, a UserForm and a standard code module are each a VBComponent.  The VBComponents collection contains each existing VBComponent object. 

CodeModule            This object represents the actual code contained in a VBComponent.  For example, when you enter code into Module1, you're entering code into the CodeModule object of the VBComponent named "Module1".  

We'll be programmatically "navigating" to these components through the Workbook object.  You can also get to these components by going through the Application.VBE object path, but we won't be doing this.  

There are various types of VBComponents, identified by the Type property of the VBComponent object. 

 

        
Type Constant Description
vbext_ct_ClassModule This is a class module, used to create your own objects.  We won't be using these here.
 
vbext_ct_Document This is the component for a worksheet, chart sheet, or ThisWorkbook.
 
vbext_ct_MSForm This is the component for a UserForm. The visual representation of the form in the VBE is called a desiger.
 
vbext_ct_StdModule This is the component for a standard code module.  Most of our procedures will work with these components.
 

 

 


Getting A Reference To An Object

The first step in programming to the VBE is to get a reference to object you need to work with.  

VBProject                
Dim VBProj As VBProject
Set VBProj = ThisWorkbook.VBProject


VBComponent 
               
Dim VBComp As VBComponent
Set VBComp = ThisWorkbook.VBProject.VBComponents("Module1")


CodeModule 
               
Dim VBCodeMod As CodeModule
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule

In all of the examples in this page, we'll be working with the ThisWorkbook object -- working with the VBA components in the workbook which contains the code.  Of course, you can work with any open workbook, by using ActiveWorkbook or
Workbooks("SomeBook.xls")

Adding A Module To A Workbook 

The procedure below will add a new module named "NewModule" to ThisWorkbook.

Sub AddModule()
Dim VBComp As VBComponent
Set VBComp =
ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "NewModule"
Application.Visible = True
End Sub

When you run this code from Excel while the VBE is open, you will be taken to the new module's code module, and the macro will terminate.  When you run this code while the VBE is not open, your Excel application will be visible, but will not have focus.  The  statement Application.Visible = True returns focus back to the Excel application.

Deleting A Module From A Workbook

The procedure below will delete the module named "NewModule" from ThisWorkbook. 

Sub DeleteModule()
Dim VBComp As VBComponent
Set VBComp = ThisWorkbook.VBProject.VBComponents("NewModule")
ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub

You cannot delete the ThisWorkbook object module, or a sheet object module, or a chart object module.

 

Adding A Procedure To A Module

The procedure below will add a new procedure called "MyNewProcedure" to the module named "NewModule" in ThisWorkbook.

Sub AddProcedure()

Dim VBCodeMod As CodeModule
Dim LineNum As Long

Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("NewModule").CodeModule
With VBCodeMod
    LineNum = .CountOfLines + 1
    .InsertLines LineNum, _
"Sub MyNewProcedure()" & Chr(13) & _
" Msgbox ""Here is the new procedure"" " & Chr(13) & _
"End Sub"
End With

Application.Run "MyNewProcedure"

End Sub

Pay attention to the way in which the .InsertLines method is called.  The entire procedure is passed as one argument -- a string with embedded Chr(13) characters for the line breaks.  The code statement

Application.Run "MyNewProcedure"

will run the new procedure.  You must use Application.Run rather than calling the procedure directly in order to prevent compile-time errors.  This method will work only if you are adding code to another code module.  If you are adding code a the same code module, you must use an Application.OnTime method, so that control is returned to Excel, and the module can be recompiled and reloaded.  Using Application.OnTime may have some synchronizations problems, so you should avoid calling a procedure that you've just added to the same code module without allowing all VBA procedures to come to an end.  

Application.OnTime Now,"NewProcedureName"

 
Creating An Event Procedure

The CodeModule object has a method called CreateEventProc that you can use to create an event procedure in and class module, a sheet object module, or the ThisWorkbook object module. The advantage of CreateEventProc over InsertLines is that CreateEventProc  will automatically insert the complete procedure declaration, including all of the correct parameters. CreateEventProc  returns the line number on which the procedure begins, so once you've called  CreateEventProc , add one to the result and use this with InsertLines  to insert the body of the event procedure.  For example, the code below creates a Workbook_Open procedure containing a Msgbox statement in the ThisWorkbook module of the Active Workbook.

Dim StartLine As Long
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
    StartLine = .CreateEventProc("Open", "Workbook") + 1
    .InsertLines StartLine, _
    "Msgbox ""Hello World"",vbOkOnly"
End With


 

Deleting A Procedure From A Module

The procedure below will delete the procedure called "MyNewProcedure" from the module named "NewModule" in ThisWorkbook.

Sub DeleteProcedure()

Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long

Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("NewModule").CodeModule
With VBCodeMod
    StartLine = .ProcStartLine("MyNewProcedure", vbext_pk_Proc)
    HowManyLines = .ProcCountLines("MyNewProcedure", vbext_pk_Proc)
    .DeleteLines StartLine, HowManyLines
End With

End Sub

 

Deleting All Code From A Module

The procedure below will delete all code from a module name "NewModule".

Sub DeleteAllCodeInModule()
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long

Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("NewModule").CodeModule
With VBCodeMod
    StartLine = 1
    HowManyLines = .CountOfLines
   .DeleteLines StartLine, HowManyLines
End With

End Sub

 

Listing All Modules In A Workbook

The procedure below will list, in a message box, all of the modules in ThisWorkbook.  It uses a function called CompTypeToName to get a string describing the type of module.   The function CompTypeToName is listed below. 

Sub ListModules()

Dim VBComp As VBComponent
Dim Msg As String

For Each VBComp In ThisWorkbook.VBProject.VBComponents
    Msg = Msg & VBComp.Name & " Type: " & CompTypeToName(VBComp) & Chr(13)
Next VBComp
MsgBox Msg

End Sub


Function CompTypeToName(VBComp As VBComponent) As String

Select Case VBComp.Type
    Case vbext_ct_ActiveXDesigner
        CompTypeToName = "ActiveX Designer"
    Case vbext_ct_ClassModule
        CompTypeToName = "Class Module"
    Case vbext_ct_Document
        CompTypeToName = "Document"
    Case vbext_ct_MSForm
        CompTypeToName = "MS Form"
    Case vbext_ct_StdModule
        CompTypeToName = "Standard Module"
    Case Else
End Select

End Function

Listing All Procedures In A Module

The follow procedure is used to list all the procedures within a module. A procedure may be a Sub or Function procedure, a Property Get procedure, a Property Let procedure, or a Property Set procedure. The function ProcsToArray populates an array of strings with the procedure type and procedure name of each procedure in the specified code module. Each element of this array is a string beginning with the type of procedure ("PROC", "GET", "LET", or "SET") followed by a colon, followed by the name of the procedure.   For example, one element of the array of string might be:
                           
SET:MyProperty
The function returns the number of procedures found in the Code Module. You can use the Split function to separate the procedure type from the procedure name, as shown in the ListProcs example procedure.

Function ProcsToArray(CodeMod As VBIDE.CodeModule, ProcArray() As String) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ProcsToArray
' This will load an array of strings with the type and name of
' each procedure in the specified code module. This procedure
' populates the array ProcArray with the type and name of each
' procedure in the code module. ProcArray must be a dynamic array
' of strings. The existing contents of ProcArray are destroyed.
' Upon completion, each element of ProcArray will be the type
' of procedure (GET,LET,SET, or PROC) followed by a colon
' followed by the name of the proceudre. E.g., "SET:Prop1".
' You can use the Split function to separate the type from the
' name. ProcArray will be a 1-based array.
' The function returns the number of procedures listed in ProcArray.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim LineNumber As String
Dim ProcType As VBIDE.vbext_ProcKind
Dim ProcNdx As Long
Dim ProcName As String
Dim ProcTypeName As String

Erase ProcArray

LineNumber = CodeMod.CountOfDeclarationLines + 1
ProcName = CodeMod.ProcOfLine(LineNumber, ProcType)

Do Until (ProcName = vbNullString) Or (LineNumber >= CodeMod.CountOfLines)
    ProcNdx = ProcNdx + 1
    ReDim Preserve ProcArray(1 To ProcNdx)
    Select Case True
        Case ProcType = vbext_pk_Get
            ProcTypeName = "GET"
        Case ProcType = vbext_pk_Let
            ProcTypeName = "LET"
        Case ProcType = vbext_pk_Proc
            ProcTypeName = "PROC"
        Case ProcType = vbext_pk_Set
            ProcTypeName = "SET"
        Case Else
            ProcTypeName = "UNK" ' unknown type
    End Select
    ProcArray(ProcNdx) = ProcTypeName & ":" & ProcName
    LineNumber = LineNumber + CodeMod.ProcCountLines(ProcName, ProcType)
    ProcName = CodeMod.ProcOfLine(LineNumber, ProcType)
Loop

ProcsToArray = ProcNdx

End Function

The following procedure demonstrate how to use ProcsToArray.

Sub ListProcs()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ListProcs
' This demonstrates the ProcsToArray function.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Procs() As String   ' array in which to store procedure information
Dim ProcName As String  ' procedure name
Dim ProcType As String  ' procedure type
Dim ProcCount As Long   ' number of procedures found
Dim Arr As Variant      ' array for Split function
Dim CodeMod As VBIDE.CodeModule
Dim Ndx As Long

Set CodeMod = ThisWorkbook.VBProject.VBComponents("Class1").CodeModule
ProcCount = ProcsToArray(CodeMod, Procs)
Debug.Print "Procs Found: " & CStr(ProcCount)
If ProcCount > 0 Then
    For Ndx = LBound(Procs) To UBound(Procs)
        Arr = Split(Procs(Ndx), ":")
        ProcType = Arr(LBound(Arr))
        ProcName = Arr(LBound(Arr) + 1)
        Debug.Print "Proc Type: " & ProcType, "Proc Name: " & ProcName
    Next Ndx
End If

End Sub

Also see Code Modules And Code Names for more information about the CodeName property of VBComponents.

 

Listing All Procedures In A Project

The follow procedure is used to list all procedures in all modules of a project. It populates the array Procs with strings that identify each procedure in the project. Each string is of the format  ModuleName:ProcType:ProcedureName, where ProcType is "PROC" for sub and function procedures, "GET" for Property  Get procedures, "SET" for Property Set procedures, and "LET" for Property Let procedures. For example, one element in the array of strings might be
                           
ClassABC:SET:MyProperty
You can use the Split function to break each array element into its components.  The function returns as its result the number of procedures found in the project.  The Procs array passed to the function must be a dynamic array of Strings.

Function ListAllProcsInProject(VBP As VBIDE.VBProject, Procs() As String) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ListAllProcsInProject
' This function populates the string array Procs with strings that identify
' a specific procedure. Each element of Procs is a string of the form:
'       ModuleName:ProcType:ProcedureName
' You can use the Split function to break this string into separate elements
' using the ':' character as the delimiter.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim ProcName As String
Dim ProcType As VBIDE.vbext_ProcKind
Dim ProcTypeString As String
Dim ProcNdx As Long
Dim ProcCounter As Long
Dim ProcString As String

If VBP.Protection = vbext_pp_locked Then
    Exit Function
End If

Erase Procs
For Each VBComp In VBP.VBComponents
    Set CodeMod = VBComp.CodeModule
    LineNum = CodeMod.CountOfDeclarationLines + 1
    ProcName = CodeMod.ProcOfLine(LineNum, ProcType)
    Do Until LineNum >= CodeMod.CountOfLines
        ProcNdx = ProcNdx + 1
        ReDim Preserve Procs(1 To ProcNdx)
        Select Case True
            Case ProcType = vbext_pk_Get
                ProcTypeString = "GET"
            Case ProcType = vbext_pk_Let
                ProcTypeString = "LET"
            Case ProcType = vbext_pk_Proc
                ProcTypeString = "PROC"
            Case ProcType = vbext_pk_Set
                ProcTypeString = "SET"
        End Select
        ProcString = VBComp.Name & ":" & ProcTypeString & ":" & ProcName
        Procs(ProcNdx) = ProcString
        ProcCounter = ProcCounter + 1
        LineNum = LineNum + CodeMod.ProcCountLines(ProcName, ProcType) + 1
        ProcName = CodeMod.ProcOfLine(LineNum, ProcType)
    Loop
Next VBComp

ListAllProcsInProject = ProcCounter

End Function

You can loop through the Procs array and use the Split function to break each string into its components, as shown in the procedure below.

Sub ListProcsInProject()

Dim Procs() As String
Dim ProcCount As Long
Dim VBP As VBIDE.VBProject
Dim Ndx As Long
Dim Arr As Variant
Dim ModuleName As String
Dim ProcType As String
Dim ProcName As String

ProcCount = ListAllProcsInProject(ThisWorkbook.VBProject, Procs)
Debug.Print "Procs Found: " & CStr(ProcCount)
If ProcCount > 0 Then
    For Ndx = LBound(Procs) To UBound(Procs)
        Arr = Split(Procs(Ndx), ":")
        ModuleName = Arr(LBound(Arr))
        ProcType = Arr(LBound(Arr) + 1)
        ProcName = Arr(LBound(Arr) + 2)
        Debug.Print "Module: " & ModuleName, "Type: " & ProcType, "Name: " & ProcName
    Next Ndx
Else
    Debug.Print "No procs found"
End If

End Sub

Getting A Procedure's Declaration From A Module

The procedure below will return as a string the procedure declaration for a specified procedure in a code module. CodeMod is the CodeModule object containing the procedure. ProcName is the name of the procedure to retrieive. ProcKind indicates what type of procedure ProcName is. ProcKind must be vbext_pk_Proc for a Sub or Function procedure, vbext_pk_Get for a Property Get procedure, vbext_pk_Let for a Property Let procedure, or vbext_pk_Set for a Property Set procedure. LineSplitBehavior determines how the procedure should handle procedure declarations that continue over 2 or more lines of code using the "_" line continuation character. If LineSplitBehavior is LineSplitRemove (0), line splits are removed and the declaration is returned as a single line of text. If LIneSplitBehavior is LineSplitKeep (1), the "_" character are retained and the declaration is returned as multiple lines of text, separated by a vbNewLine character. If LineSplitBehavior is LineSplitConvert, the "_" characters are removed and replaced by vbNewLine characters and the declaration is returned as multiple lines of text.  The procedure requires the Enum variable and the SingleSpace function, as shown below.

Public Enum LineSplits
    LineSplitRemove = 0
    LineSplitKeep = 1
    LineSplitConvert = 2
End Enum
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

Exporting All Modules In A Project

The procedure below will list export all of the modules in a workbook to text files. It will save the files in the same folder as the workbook.  This can be useful for saving a backup copy of your VBA, or for transferring VBA code from one project to another.

Sub ExportAllVBA()
Dim VBComp As VBIDE.VBComponent
Dim Sfx As String

For Each VBComp In ActiveWorkbook.VBProject.VBComponents
    Select Case VBComp.Type
        Case vbext_ct_ClassModule, vbext_ct_Document
           Sfx = ".cls"
        Case vbext_ct_MSForm
           Sfx = ".frm"
        Case vbext_ct_StdModule
           Sfx = ".bas"
        Case Else
           Sfx = ""
    End Select
    If Sfx <> "" Then
       VBComp.Export _
          Filename:=ActiveWorkbook.Path & "\" & VBComp.Name & Sfx
    End If
Next VBComp
End Sub

Deleting All VBA Code In A Project

The procedure below will delete all the VBA code in a project.  You should use this procedure with care, as it will permanently delete the code.  Standard modules, user forms, and class modules will be removed, and code within the ThisWorkbook module and the sheet modules will be deleted.  You may want to export the VBA code, using the procedure above, before deleting the VBA code.

Sub DeleteAllVBA()

Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents

Set VBComps = ActiveWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
   Select Case VBComp.Type
      Case vbext_ct_StdModule, vbext_ct_MSForm, _
            vbext_ct_ClassModule
         VBComps.Remove VBComp
      Case Else
         With VBComp.CodeModule
            .DeleteLines 1, .CountOfLines
         End With
   End Select
Next VBComp

End Sub

Copying Modules Between Projects

There isn't a single method to copy modules from one VBProject to another.  Instead, you have to export the module from one project, and then import it into another.   The following procedure will copy Module1 from Book2 to Book1.  

Sub CopyOneModule()

Dim FName As String
With Workbooks("Book2")
    FName = .Path & "\code.txt"
    .VBProject.VBComponents("Module1").Export FName
End With
Workbooks("book1").VBProject.VBComponents.Import FName

End Sub

Just change "Module1" to the name of the module you want to copy.  If you want to copy all modules (except the ThisWorkbook and Sheet modules), you can use the following code. 

Sub CopyAllModules()

Dim FName As String
Dim VBComp As VBIDE.VBComponent

With Workbooks("Book2")
    FName = .Path & "\code.txt"
    If Dir(FName) <> "" Then
        Kill FName
    End If
    For Each VBComp In .VBProject.VBComponents
        If VBComp.Type <> vbext_ct_Document Then
           VBComp.Export FName
           Workbooks("book1").VBProject.VBComponents.Import FName
           Kill FName
        End If
    Next VBComp
End With

End Sub

 

Testing Existence Of A Module Or Procedure

You can use the VBA Extensibility tools to determine whether a module exists, or a procedure exists in a module. 

Function ModuleExists(ModuleName As String) As Boolean
On Error Resume Next
ModuleExists = Len( _
ThisWorkbook.VBProject.VBComponents(ModuleName).Name) <> 0
End Function
 

Function ProcedureExists(ProcedureName As String, _
    ModuleName As String) As Boolean
On Error Resume Next
If ModuleExists(ModuleName) = True Then
    ProcedureExists = ThisWorkbook.VBProject.VBComponents(ModuleName) _
       .CodeModule.ProcStartLine(ProcedureName, vbext_pk_Proc) <> 0
End If
End Function

 

Renaming Code Modules

You can rename VBA's code modules with code like

ThisWorkbook.VBProject.VBComponents("Module1").Name = "NewModule"
 

This code will work with any VBComponent, including the built-in components such as the sheet modules and the ThisWorkbook module:

ThisWorkbook.VBProject.VBComponents("ThisWorkbook").Name = "MyWorkbook"



Eliminating Screen Flickering

When  you use code to write code, the VBA Editor displays itself.  Broadly speaking, this is undesirable. You can reduce this to a flicker by using code like

Application.VBE.MainWindow.Visible = False

This will close the VBA Editor, but you may still see the editor appear momentarily and then hide itself. To prevent this screen flickering, you need to use the
LockWindowUpdate API function. Put the following function declares at the top of your code module, before and outside of any procedures. Note that the Declare statements below must appear outside of and above any procedure in the module.  

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

 

Then, in your code, use code like the following:

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 to write code
'
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&

You may still see the title bar of Excel momentarily dim, but the VBA Editor will not be visible at all. If you already have error handling code in your procedure that writes the VBA code, you want to be sure to call LockWindowUpdate 0&.You MUST call LockWindowUpdate 0&.


The code above will work in Excel 2000 and later. It has not been tested in Excel97.