Sample Code
Adding A Module To A Project
This code will add new code module named NewModule to the VBProject of the active workbook. The type of VBComponent is specified by the value of the parameter passed to the Add method.
Public Sub AddModuleToProject()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "NewModule"
End Sub
Adding A Procedure To A Module
This code will add a simple "Hello World" procedure named SayHello to the end of the module named Module1.
Sub AddProcedureToModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Public Sub SayHello()"
LineNum = LineNum + 1
.InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
End Sub
Creating An Event Procedure
This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used. 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
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
ProcName = .ProcOfLine(LineNum, ProcKind)
Do Until LineNum >= .CountOfLines
Rng(1, 1).Value = ProcName
Rng(1, 2).Value = ProcKindString(ProcKind)
Set Rng = Rng(2, 1)
LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) + 1
ProcName = .ProcOfLine(LineNum, ProcKind)
Loop
End With
End Sub
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
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
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
Dim VBP As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim LineCount As Long
If VBProj Is Nothing Then
Set VBP = ActiveWorkbook.VBProject
Else
Set VBP = VBProj
End If
If VBP.Protection = vbext_pp_locked Then
TotalLinesInProject = -1
Exit Function
End If
For Each VBComp In VBP.VBComponents
LineCount = LineCount + VBComp.CodeModule.CountOfLines
Next VBComp
TotalLinesInProject = LineCount
End Function
Total Code Lines In A Component
This function will return the total number of code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.
Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long
Dim N As Long
Dim S As String
Dim LineCount As Long
If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
TotalCodeLinesInVBComponent = -1
Exit Function
End If
With VBComp.CodeModule
For N = 1 To .CountOfLines
S = .Lines(N, 1)
If Trim(S) = vbNullString Then
' blank line, skip it
ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
Else
LineCount = LineCount + 1
End If
Next N
End With
TotalCodeLinesInVBComponent = LineCount
End Function
Total Code Lines In A Project
This function will return the total number of code lines in all the components of a VBProject. It ignores blank lines and comment lines. It will return -1 if the project is locked.
Public Function TotalCodeLinesInProject(VBProj As VBIDE.VBProject) As Long
Dim VBComp As VBIDE.VBComponent
Dim LineCount As Long
If VBProj.Protection = vbext_pp_locked Then
TotalCodeLinesInProject = -1
Exit Function
End If
For Each VBComp In VBProj.VBComponents
LineCount = LineCount + TotalCodeLinesInVBComponent(VBComp)
Next VBComp
TotalCodeLinesInProject = LineCount
End Function
Procnames Function
Function to return the names of Procedures in a given module
Function ProcNames(ByRef strMName As String) As String()
Dim lngSLine As Long ' Line Number
Dim vbCodeMod As CodeModule ' Object for Code Module
Dim intPCount As Integer ' Procedure Count
Dim pnamearray() As String ' Procedure Names Array
' Set named module as module object
Set vbCodeMod = ThisWorkbook.VBProject.VBComponents(strMName).CodeModule
' Scan through module looking for Declaration lines
' and set up array of macro names as we go
With vbCodeMod
lngSLine = .CountOfDeclarationLines + 1
Do Until lngSLine >= .CountOfLines
intPCount = intPCount + 1
ReDim Preserve pnamearray(intPCount)
pnamearray(intPCount) = .ProcOfLine(lngSLine, vbext_pk_Proc)
lngSLine = lngSLine + .ProcCountLines(.ProcOfLine(lngSLine, vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
' Return array of Procedure names
ProcNames = pnamearray()
End Function
ModExist Function
This function test to see if a given VBA module exists in the current project.
Function ModExist(strModName As String) As Boolean
Dim intVBCcnt As Integer
Dim intVBDcnt As Integer
Dim intLC1 As Integer
' Set up count of modules in project
intVBCcnt = ThisWorkbook.VBProject.VBComponents.Count
intVBDcnt = 0
' Loop through module names
For intLC1 = 1 To intVBCcnt
If ThisWorkbook.VBProject.VBComponents(intLC1).Type = vbext_ct_StdModule Then
If ThisWorkbook.VBProject.VBComponents(intLC1).Name = strModName Then
ModExist = True
GoTo Exit_ModExist
End If
End If
Next intLC1
ModExist = False
Exit_ModExist:
End Function
© 2020 Better Solutions Limited. All Rights Reserved. © 2020 Better Solutions Limited TopPrevNext