VBA Snippets
AddControl_FormComboBox
Adds a combo box to a userfrom in a VBE project.Public Sub VBE_AddControl_FormComboBox(ByVal sFormName As String, _
ByVal sComboBoxName As String, _
ByVal iComboBoxWidth As Integer, _
ByVal iComboBoxHeight As Integer, _
ByVal iComboBoxLeft As Integer, _
ByVal iComboBoxTop As Integer)
Dim vbcFormName 'As VBComponent
Dim combobox As MSForms.combobox
Dim vno As Variant
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
Set combobox = vbcFormName.Designer.Controls.Add("forms.combobox.1", _
sComboBoxName)
With combobox
.Width = iComboBoxWidth
.Height = iComboBoxHeight
.Left = iComboBoxLeft
.Top = iComboBoxTop
.ListWidth = iComboBoxWidth
.ColumnWidths = iComboBoxWidth
End With
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_AddControl_FormComboBox", msMODULENAME, 1, _
"add the Combo Box " & sComboBoxName & " to the userform " & sFormName)
End Sub
AddControl_FormCommandButton
Adds a command button to a userform in the active project.Public Sub VBE_AddControl_FormCommandButton(ByVal sFormName As String, _
ByVal sCommandButtonCaption As String, _
ByVal sCommandButtonName As String, _
ByVal iCommandButtonHeight As Integer, _
ByVal iCommandButtonLeft As Integer, _
ByVal iCommandButtonTop As Integer, _
ByVal iCommandButtonWidth As Integer, _
ByVal lcommandbuttonForecolour As Long, _
ByVal lcommandbuttonBackcolour As Long, _
ByVal sCodeOnClick As String)
Dim vbcFormName 'As VBComponent
Dim commandbutton As MSForms.commandbutton
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
Set commandbutton = vbcFormName.Designer.Controls.Add("forms.commandbutton.1", _
sCommandButtonName)
With commandbutton
.Caption = sCommandButtonCaption
.Width = iCommandButtonWidth
.Height = iCommandButtonHeight
.Left = iCommandButtonLeft
.Top = iCommandButtonTop
.ForeColor = lcommandbuttonForecolour
.BackColor = lcommandbuttonBackcolour
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 10
End With
End With
Call VBE_FormCodeAdd(sFormName, "Private Sub " & sCommandButtonName & "_click()")
Call VBE_FormCodeAdd(sFormName, " " & sCodeOnClick)
Call VBE_FormCodeAdd(sFormName, "End Sub")
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormCommandButtonAdd", msMODULENAME, 1, _
"add the Command Button " & sCommandButtonName & " to the userform " & sFormName)
End Sub
AddControl_FormLabel
Adds a label to a userfrom in the active VBE project.Public Sub VBE_FormLabelAdd(sFormName As String, _
sLabelCaption As String, _
sLabelName As String, _
iLabelHeight As Integer, _
iLabelLeft As Integer, _
iLabelTop As Integer, _
iLabelWidth As Integer, _
sCodeOnClick As String)
Dim vbcFormName 'As VBComponent
Dim label As MSForms.label
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
Set label = vbcFormName.Designer.Controls.Add("forms.label.1", sLabelName)
With label
.Caption = sLabelCaption
.Width = iLabelWidth
.Height = iLabelHeight
.Left = iLabelLeft
.Top = iLabelTop
End With
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormLabelAdd", msMODULENAME, 1, _
"add the Label control """ & sLabelName & """ " & _
"to the userform " & """" & sFormName & """")
End Sub
AddControl_FormListBox
Adds a listbox to a userfrom in the active VBE project.Public Sub VBE_FormListBoxAdd(sFormName As String, _
sListBoxName As String, _
ilistboxwidth As Integer, _
ilistboxheight As Integer, _
ilistboxleft As Integer, _
ilistboxtop As Integer)
Dim vbcFormName 'As VBComponent
Dim listbox As MSForms.listbox
Dim vno As Variant
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
Set listbox = vbcFormName.Designer.Controls.Add("forms.listbox.1", _
sListBoxName)
With listbox
.Width = ilistboxwidth
.Height = ilistboxheight
.Left = ilistboxleft
.Top = ilistboxtop
.ColumnWidths = ilistboxwidth
End With
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormListBoxAdd", msMODULENAME, 1, _
"add the List Box control """ & sListBoxName & """ " & _
"to the userform " & """" & sFormName & """")
End Sub
AddControl_FormOptionButton
Adds an option button to a userform in the active VBE project.Public Sub VBE_FormOptionButtonAdd(sFormName As String, _
sOptionButtonCaption As String, _
sOptionButtonName As String, _
iOptionButtonHeight As Integer, _
iOptionButtonLeft As Integer, _
iOptionButtonTop As Integer, _
iOptionButtonWidth As Integer, _
sCodeOnClick As String)
Dim vbcFormName 'As VBComponent
Dim optionbutton As MSForms.optionbutton
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
Set optionbutton = vbcFormName.Designer.Controls.Add("forms.optionbutton.1", _
sOptionButtonName)
With optionbutton
.Caption = sOptionButtonCaption
.Width = iOptionButtonWidth
.Height = iOptionButtonHeight
.Left = iOptionButtonLeft
.Top = iOptionButtonTop
End With
End With
Call VBE_FormCodeAdd(sFormName, "Private Sub " & sOptionButtonName & "_click()")
Call VBE_FormCodeAdd(sFormName, " " & sCodeOnClick)
Call VBE_FormCodeAdd(sFormName, "End Sub")
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormOptionButtonAdd", msMODULENAME, 1, _
"add the Option Button control """ & sOptionButtonName & """ control " & _
"to the userform" & """" & sFormName & """")
End Sub
AddControl_FormTextBox
Adds a textbox to a userform in the active VBE project.Public Sub VBE_FormTextBoxAdd(sFormName As String, _
sTextBoxCaption As String, _
sTextBoxName As String, _
iTextBoxHeight As Integer, _
iTextBoxLeft As Integer, _
iTextBoxTop As Integer, _
iTextBoxWidth As Integer, _
sCodeOnClick As String, _
Optional sDefaultText As String = "")
Dim vbcFormName 'As VBComponent
Dim textbox As MSForms.textbox
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
Set textbox = vbcFormName.Designer.Controls.Add("forms.textbox.1", _
sTextBoxName)
With textbox
.Width = iTextBoxWidth
.Height = iTextBoxHeight
.Left = iTextBoxLeft
.Top = iTextBoxTop
.value = sDefaultText
End With
End With
Call VBE_FormCodeAdd(sFormName, "Private Sub " & sTextBoxName & "_click()")
Call VBE_FormCodeAdd(sFormName, " " & sCodeOnClick)
Call VBE_FormCodeAdd(sFormName, "End Sub")
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormTextBoxAdd", msMODULENAME, 1, _
"Text Box """ & sTextBoxName & """ control " & _
"to the userform """ & sFormName & """")
End Sub
Component_Add
Adds a new component to a VBE project.Public Sub VBE_ComponentAdd()
On Error GoTo AnError
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ComponentAdd", msMODULENAME, 1, _
"")
End Sub
Component_Exists
Public Function VBE_ComponentExists( _
ByVal VBCompName As String, _
Optional ByVal VBProj As VBIDE.VBProject = Nothing) As Boolean
Dim VBP As VBIDE.VBProject
On Error GoTo ErrorHandler
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))
Exit Function
ErrorHandler:
End Function
Component_Export
Exports a component to a folder from a VBE project. If FileName is missing, the code will be exported to a file with the same name as the VBComponent followed by the appropriate extension. This can be useful if you are archiving modules to create a library of useful module to be used in other projects.Public Sub VBE_ComponentExport(sComponentName As String, _
sFolderPath As String, _
sFileName As String, _
sExtension As String)
On Error GoTo AnError
If File_Exists(sFolderPath, sFileName, sExtension) = True Then _
Call File_Delete(sFolderPath, sFileName, "", sExtension)
ActiveDocument.AttachedTemplate.VBProject.VBComponents(sComponentName).Export _
FileName:=sFolderPath & sFileName & sExtension
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ComponentExport", msMODULENAME, 1, _
"export the VBA module")
End Sub
Public Function ExportVBComponent(ByVal VBComp As VBIDE.VBComponent, _
ByVal FolderName As String, _
Optional ByVal FileName As String, _
Optional ByVal OverwriteExisting As Boolean = True) As Boolean
Dim Extension As String
Dim FName As String
Extension = GetFileExtension(VBComp:=VBComp)
If Trim(FileName) = vbNullString Then
FName = VBComp.Name & Extension
Else
FName = FileName
If InStr(1, FName, ".", vbBinaryCompare) = 0 Then
FName = FName & Extension
End If
End If
If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then
FName = FolderName & FName
Else
FName = FolderName & "\" & FName
End If
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
If OverwriteExisting = True Then
Kill FName
Else
ExportVBComponent = False
Exit Function
End If
End If
VBComp.Export FileName:=FName
ExportVBComponent = True
End Function
Public Function GetFileExtension(ByVal VBComp As VBIDE.VBComponent) As String
Select Case VBComp.Type
Case vbext_ct_ClassModule
GetFileExtension = ".cls"
Case vbext_ct_Document
GetFileExtension = ".cls"
Case vbext_ct_MSForm
GetFileExtension = ".frm"
Case vbext_ct_StdModule
GetFileExtension = ".bas"
Case Else
GetFileExtension = ".bas"
End Select
End Function
Component_FormAdd
Adds a new userform to the active project.Public Function VBE_FormAdd(sFormName As String) As String
Dim frmTempForm 'As VBComponent
On Error GoTo AnError
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_FormAdd", msMODULENAME, 1, _
"the userform """ & sFormName & """ to the workbook """ & _
ActiveDocument.Name & """")
End Function
Component_FormControlMove
Moves a control on a userform in the active VBE project.Public Sub VBE_FormControlMove(sFormName As String, _
sControlName As String, _
iCtrlLeft As Integer, _
iCtrlTop As Integer)
Dim vbcFormName 'As VBComponent
Dim imagecontrol As MSForms.Image
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName.Designer.Controls(sControlName)
.Top = iCtrlTop
.Left = iCtrlLeft
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormControlMove", msMODULENAME, 1, _
"move the control " & sControlName & " on the userform " & sFormName)
End Sub
Component_FormControlSize
Adjusts the size of a control on a userform in the active VBE project.Public Sub VBE_FormControlSize(sFormName As String, _
sControlName As String, _
iCtrlHeight As Integer, _
iCtrlWidth As Integer)
Dim vbcFormName 'As VBComponent
Dim imagecontrol As MSForms.Image
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName.Designer.Controls(sControlName)
.Height = iCtrlHeight
.Width = iCtrlWidth
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormControlSize", msMODULENAME, 1, _
"adjust the the size of the control " & sControlName & " to Height=" & _
iCtrlHeight & " and " & "to Width=" & iCtrlWidth & " on the userform " & sFormName)
End Sub
Component_FormDelete
Deletes a userfom from the active VBE project.Public Sub VBE_FormDelete(sFormName As String)
On Error GoTo AnError
ActiveDocument.VBProject.VBComponents.Remove _
VBComponent:=ActiveDocument.VBProject.VBComponents(sFormName)
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormDelete", msMODULENAME, 1, _
"delete the userform " & sFormName)
End Sub
Component_FormGeneralDeleteExtraControls
Used for the Dynamic Userform to delete any extra controls from the userform that may have been added.Public Sub VBE_FormGeneralDeleteExtraControls(sFormName As String)
Dim vbcFormName 'As VBComponent
Dim eachcontrol As MSForms.control
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
For Each eachcontrol In vbcFormName.Designer.Controls
If eachcontrol.Width <> 30 And _
eachcontrol.Width <> 140 Then 'ie not an image or a ref edit
vbcFormName.Designer.Controls.Remove eachcontrol.Name
End If
Next eachcontrol
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormGeneralDeleteExtraControls", msMODULENAME, 1, _
"delete all the extra controls that have been added to the userform """ & _
sFormName & """ in order to reset it")
End Sub
Component_FormGeneralPosition
Used for the Dynamic Userform to position the Image in the correct place to be displayed on a userfrom to display a message.Public Sub VBE_FormGeneralPosition(sFormName As String, _
sImageToShow As String, _
iMessageBoxHeight As Integer)
Dim vbcFormName 'As VBComponent
Dim imagecontrol As MSForms.Image
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName.Designer
.Controls("ImageQuestion").Top = iMessageBoxHeight + 100
.Controls("ImageExclamation").Top = iMessageBoxHeight + 100
.Controls("ImageInformation").Top = iMessageBoxHeight + 100
.Controls("ImageCritical").Top = iMessageBoxHeight + 100
.Controls("RefEdit1").Top = iMessageBoxHeight + 100
If sImageToShow = "ImageQuestion" Then
.Controls("ImageQuestion").Top = 9
.Controls("ImageQuestion").Left = 5.5
End If
If sImageToShow = "ImageExclamation" Then
.Controls("ImageExclamation").Top = 10
.Controls("ImageExclamation").Left = 6
End If
If sImageToShow = "ImageInformation" Then
.Controls("ImageInformation").Top = 10
.Controls("ImageInformation").Left = 8
End If
If sImageToShow = "ImageCritical" Then
.Controls("ImageCritical").Top = 10
.Controls("ImageCritical").Left = 6
End If
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormImagePosition", msMODULENAME, 1, _
"move the refedit & image controls on the userform """ & sFormName & _
""" ready to display the " & sImageToShow)
End Sub
Component_FormGeneralResetControls
Used for the Dynamic Userform to reset all the controls after the userform has been displayed.Public Sub VBE_FormGeneralResetControls(sFormName As String)
Dim vbcFormName 'As VBComponent
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName.Designer
.Controls("ImageQuestion").Top = 12
.Controls("ImageQuestion").Left = 10
.Controls("ImageExclamation").Top = 12
.Controls("ImageExclamation").Left = 40
.Controls("ImageInformation").Top = 12
.Controls("ImageInformation").Left = 70
.Controls("ImageCritical").Top = 12
.Controls("ImageCritical").Left = 100
.Controls("RefEdit1").Top = 48
.Controls("RefEdit1").Left = 18
End With
vbcFormName.Properties("Height").value = 100
vbcFormName.Properties("Width").value = 180
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormGeneralResetControls", msMODULENAME, 1, _
"reset the position of the refedit & image controls " & _
"on the userform & """ & sFormName & """")
End Sub
Component_FormModal
Add to General or Excel ?????.Public Sub VBE_FormModal(sFormName As String, _
bModal As Boolean)
Dim mlHWnd As Long
On Error GoTo AnError
'Switch between modal and modeless
mlHWnd = FindWindowA("WDMAIN", Application.Caption) 'find the main window
If bModal = True Then Call EnableWindow(mlHWnd, 0)
If bModal = False Then Call EnableWindow(mlHWnd, 1)
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormModal", msMODULENAME, 1, _
"adjust the mode of the userform """ & sFormName & """ " & _
"to either modal or modeless")
End Sub
Component_FormShow
Displays a userform in the active VBE project.Public Function VBE_FormShow(sFormName As String) As String
On Error GoTo AnError
VBA.Userforms.Add(ActiveDocument.VBProject.VBComponents(sFormName).Name).Show
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_FormShow", msMODULENAME, 1, _
"")
End Function
Component_FormSize
Adjusts the width and size (??) of a userform in the active VBE project.Public Function VBE_FormSize(sFormName As String, _
iFormHeight As Integer, _
iFormWidth As Integer, _
sTitle As String) As String
Dim vbcFormName 'As VBComponent
On Error GoTo AnError
Set vbcFormName = ActiveDocument.VBProject.VBComponents(sFormName)
With vbcFormName
.Properties("Height").value = iFormHeight
.Properties("Width").value = iFormWidth
If sTitle <> "" Then .Properties("Caption").value = sTitle
If sTitle = "" Then .Properties("Caption").value = gsBANKNAME
End With
Set vbcFormName = Nothing
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_FormSize", msMODULENAME, 1, _
"")
End Function
Component_Import
Imports a component from a given folder to a VBE project.Public Sub VBE_ComponentImport(sFolderPath As String, _
sFileName As String)
On Error GoTo AnError
ActiveDocument.VBProject.VBComponents.Import sFolderPath & sFileName
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ComponentImport", msMODULENAME, 1, _
"import the VBA module")
End Sub
Component_Remove
Removes a component from a VBE project.Public Sub VBE_ComponentRemove()
On Error GoTo AnError
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ComponentRemove", msMODULENAME, 1, _
"")
End Sub
Component_TypeReturn
Returns the type of component found in a Project. The component can either be "ActiveX Designer", "Document","Standard Module","Userform" or "Class Module".Public Function VBE_ComponentTypeReturn(vbComp As VBIDE.VBComponent) As String
On Error GoTo AnError
Select Case vbComp.Type
Case vbext_ct_ActiveXDesigner: VBE_ComponentTypeReturn = "ActiveX Designer"
Case vbext_ct_Document: VBE_ComponentTypeReturn = "Document"
Case vbext_ct_StdModule: VBE_ComponentTypeReturn = "Standard Module"
Case vbext_ct_MSForm: VBE_ComponentTypeReturn = "Userform"
Case vbext_ct_ClassModule: VBE_ComponentTypeReturn = "Class Module"
End Select
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_ComponentTypeReturn", msMODULENAME, 1, _
"")
End Function
EventProcedureAdd
This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used. This code will create the declaration line and the end of procedure line. It returns the line number on which the event procedure begins.Public Sub VBE_EventProcedureAdd()
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
Module_Add
Adds a blank VBA 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 VBE_ModuleAdd( _
ByVal sModuleName As String, _
Optional ByVal sDocName As String = "")
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
On Error GoTo ErrorHandler
If sDocName = "" Then sDocName = ActiveDocument.Name
Set VBProj = Documents(sDocName).VBProject
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = sModuleName
If g_bDEBUG = False Then Exit Sub
ErrorHandler:
Call Error_Handle("VBE_ModuleAdd", msMODULENAME, 1, _
"add a new module called """ & sModuleName & _
""" to the document """ & sDocName & """")
End Sub
Module_CodeAdd
Adds VBA Code to a module in the active project ??? Resume Next.Public Sub VBE_CodeAdd(sComponentName As String, _
sCodeToAdd As String, _
Optional sDocName As String = "", _
Optional bTemplate As Boolean = False)
Dim modFormModule As CodeModule
Dim lcurrenttotallines As lLong
On Error Resume Next
If bTemplate = True Then
Set modFormModule = ThisDocument.VBProject.VBComponents(sComponentName).CodeModule
Else
If sDocName = "" Then sDocName = ActiveDocument.Name
Set modFormModule = _
Documents(sDocName).VBProject.VBComponents(sComponentName).CodeModule
End If
If Not modFormModule Is Nothing Then
With modFormModule
lcurrenttotallines = .CountOfLines
.InsertLines lcurrenttotallines + 1, sCodeToAdd
End With
Set modFormModule = Nothing
End If
On Error GoTo 0
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_FormCodeAdd", msMODULENAME, 1, _
"add the code" & vbCrLf & sCodeToAdd & vbCrLf & _
"to the component """ & sComponentName & """")
End Sub
Public Function VBE_ModuleCodeAdd(vbModuleComp As VBIDE.VBComponent, _
sProcedureName As String, _
sProcedureCode As String) As Boolean
Dim lstartline As Long
Dim lnooflines As Long
On Error GoTo AnError
With vbModuleComp.CodeModule
lnooflines = .CountOfLines + 1
.InsertLines lnooflines, sProcedureCode
End With
' not sure if we need to run it ???
' Application.Run sProcedureName
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_ModuleCodeAdd", msMODULENAME, 1, _
"")
End Function
Module_CodeDeleteAll
Public Sub VBE_CodeDeleteAll(sComponentName As String)
Dim modFormModule As CodeModule
On Error GoTo AnError
Set modFormModule = ActiveDocument.VBProject.VBComponents(sComponentName).CodeModule
modFormModule.DeleteLines 1, modFormModule.CountOfLines
Set modFormModule = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_CodeDeleteAll", msMODULENAME, 1, _
"delete all the code associated with the userform """ & sFormName & """")
End Sub
Module_CodeLineExists
???? Resume Next.Public Function VBE_CodeLineExists(sComponentName As String, _
sText As String) As Boolean
Dim modFormModule As CodeModule
Dim ltotallines As Long
Dim llinecount As Long
Dim slineoftext As String
On Error Resume Next
Set modFormModule = ActiveDocument.VBProject.VBComponents(sComponentName).CodeModule
ltotallines = modFormModule.CountOfLines
For llinecount = 1 To ltotallines
slineoftext = modFormModule.Lines(llinecount, 1)
If slineoftext = sText Then
VBE_CodeLineExists = True
Exit Function
End If
Next llinecount
VBE_CodeLineExists = False
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_CodeLineExists", msMODULENAME, 1, _
"")
End Function
Module_CodeLinesNo
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 VBE_Module_CodeLinesNo( _
ByVal VBComp As VBIDE.VBComponent) As Long
Dim N As Long
Dim S As String
Dim LineCount As Long
If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
TotalCodeLinesInVBComponent = -1
Exit Function
End If
With VBComp.CodeModule
For N = 1 To .CountOfLines
S = .Lines(N, 1)
If Trim(S) = vbNullString Then
' blank line, skip it
ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
Else
LineCount = LineCount + 1
End If
Next N
End With
VBE_Module_CodeLinesNo = LineCount
End Function
Module_DocCodeAdd
Adds code to the "ThisDocument" module in a VBE project.Public Function VBE_ModuleDocCodeAdd(sCodeToAdd As String, _
Optional sDocName As String = "") As Boolean
Dim modCodeModule
Dim lcurrenttotallines As Long
On Error GoTo AnError
Set modCodeModule = Workbooks(sWbkName).VBProject. _
VBComponents("ThisWorkbook").CodeModule
If Not modCodeModule Is Nothing Then
With modCodeModule
lcurrenttotallines = .CountOfLines
.InsertLines lcurrenttotallines + 1, sCodeToAdd
End With
Set modCodeModule = Nothing
End If
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_ModuleDocCodeAny", msMODULENAME, 1, _
"determine if there is any code in a particular code module")
End Function
Module_DocCodeAny
Determines if there is any code in the "ThisDocument" module in a VBE project.Public Function VBE_ModuleDocCodeAny(sCodeToAdd As String, _
Optional sDocName As String = "") As Boolean
Dim modCodeModule
Dim lcurrenttotallines As Long
Set modCodeModule = Documents(sDocName).VBProject. _
VBComponents("ThisDocument").CodeModule
If Not modCodeModule Is Nothing Then
With modCodeModule
End With
Set modCodeModule = Nothing
End If
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_ModuleDocCodeAny", msMODULENAME, 1, _
"determine if there is any code in a particular code module")
End Function
Module_DocCodeDeleteAll
Deletes all the code in the "ThisDocument" module in a VBE project.Public Sub VBE_ModuleDocCodeDeleteAll(Optional sDocName As String = "")
Dim modCodeModule
On Error GoTo AnError
Set modCodeModule = Documents(sDocName).VBProject. _
VBComponents("ThisDocument").CodeModule
modCodeModule.DeleteLines 1, modCodeModule.CountOfLines
Set modCodeModule = Nothing
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ModuleDocCodeAny", msMODULENAME, 1, _
"determine if there is any code in ???? code module")
End Sub
Module_Exists
This function test to see if a given VBA module exists in the current project.Public Function VBE_Module_Exists( _
ByVal sModuleName As String) As Boolean
Dim intVBCcnt As Integer
Dim intVBDcnt As Integer
Dim intLC1 As Integer
intVBCcnt = ThisWorkbook.VBProject.VBComponents.Count
intVBDcnt = 0
For intLC1 = 1 To intVBCcnt
If ThisWorkbook.VBProject.VBComponents(intLC1).Type = vbext_ct_StdModule Then
If ThisWorkbook.VBProject.VBComponents(intLC1).Name = sModuleName Then
ModExist = True
GoTo Exit_ModExist
End If
End If
Next intLC1
VBE_Module_Exists = False
Exit_ModExist:
End Function
Module_Export
Exports a VBA module from the active project and saves it to a folder.Public Sub VBE_ModuleExport(sModuleName As String, _
sFolderPath As String, _
sFileName As String, _
Optional sDocName As String = "")
On Error GoTo AnError
If sDocname = "" Then sDocName = ActiveDocument.Name
Documents(sDocName) .VBProject.VBComponents(sModuleName).Export _
FileName:=sFolderPath & sFileName
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ModuleRemove", msMODULENAME, 1, _
"export the module """ & sModuleName & _
""" from the workbook """ & sWbkName & """")
End Sub
Module_Import
Imports a VBA module into the active project.Public Sub VBE_ModuleImport(sFolderPath As String, _
sFileName As String, _
Optional sDocName As String = "")
On Error GoTo AnError
If sDocName = "" Then sDocName = ActiveDocument.Name
Documents(sDocName).VBProject.VBComponents.Import sFolderPath & sFileName
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ModuleRemove", msMODULENAME, 1, _
"import the module """ & sModuleName & _
""" from the folder" & vbCrLf & sFolderPath)
End Sub
Module_ProcedureAdd
This code will add a simple "Hello World" procedure named SayHello to the end of the module named Module1.Public Sub VBE_ModuleProcedureAdd()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
On Error GoTo ErrorHandler
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
Exit Sub
ErrorHandler:
End Sub
Module_ProcedureRemove
Removes a particular procedure from a code module.Public Function VBE_ModuleProcedureRemove( _
ByVal vbModuleComp As VBIDE.VBComponent, _
ByVal sProcedureName As String) As Boolean
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim lstartline As Long
Dim lnooflines As Long
On Error GoTo ErrorHandler
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
ProcName = "DeleteThisProc"
With CodeMod
lstartline = .ProcStartLine(ProcName, vbext_pk_Proc)
lnooflines = .ProcCountLines(ProcName, vbext_pk_Proc)
.DeleteLines StartLine:=StartLine, Count:=NumLines
End With
If g_bDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle("VBE_ModuleProcedureRemove", msMODULENAME, 1, _
"")
End Function
Module_ProceduresList
Lists all the procedures in a code module.Public Function VBE_ModuleProceduresList(vbModuleComp As VBIDE.VBComponent, _
Optional sSeperatorChar As String = ",") As String
Dim lstartline As Long
Dim lnooflines As Long
Dim stext As String
On Error GoTo AnError
With vbModuleComp.CodeModule
lstartline = .CountOfDeclarationLines + 1
Do Until lstartline >= .CountOfLines
stext = stext & .ProcOfLine(lstartline, vbext_pk_Proc) & vbCrLf
lstartline = lstartline + _
.ProcCountLines(.ProcOfLine(lstartline, vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
VBE_ModuleProceduresList = stext
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_ModuleProceduresList", msMODULENAME, 1, _
"")
End Function
Public Sub ListProceduresInExcel()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim NumLines As Long
Dim WS As Worksheet
Dim Rng As Range
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
Set WS = ActiveWorkbook.Worksheets("Sheet1")
Set Rng = WS.Range("A1")
With CodeMod
LineNum = .CountOfDeclarationLines + 1
ProcName = .ProcOfLine(LineNum, ProcKind)
Do Until LineNum >= .CountOfLines
Rng(1, 1).Value = ProcName
Rng(1, 2).Value = ProcKindString(ProcKind)
Set Rng = Rng(2, 1)
LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) + 1
ProcName = .ProcOfLine(LineNum, ProcKind)
Loop
End With
End Sub
Public Function ProcKindString(ByVal ProcKind As VBIDE.vbext_ProcKind) As String
Select Case ProcKind
Case vbext_pk_Get
ProcKindString = "Property Get"
Case vbext_pk_Let
ProcKindString = "Property Let"
Case vbext_pk_Set
ProcKindString = "Property Set"
Case vbext_pk_Proc
ProcKindString = "Sub Or Function"
Case Else
ProcKindString = "Unknown Type: " & CStr(ProcKind)
End Select
End Function
Module_Remove
Deletes a VBA module from the active project. Note that you cannot remove any of the Sheet modules or the ThisWorkbook module. In general, you cannot delete a module whose Type is vbext_ct_Document.Public Sub VBE_ModuleRemove(ByVal sModuleName As String, _
Optional ByVal sDocName As String = "")
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
On Error GoTo ErrorHandler
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
VBProj.VBComponents.Remove VBComp
Documents(sDocName).VBProject.VBComponents.Remove _
Documents(sDocName).VBProject.VBComponents(sModuleName)
If g_bDEBUG = False Then Exit Sub
ErrorHandler:
Call Error_Handle("VBE_ModuleRemove", msMODULENAME, 1, _
"module " & sModuleName & " from the document " & sDocName)
End Sub
Project_CodeLinesTotal
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 VBE_Project_CodeLinesTotal( _
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
VBE_Project_CodeLinesTotal = LineCount
End Function
Project_ExportAll
Public Sub VBE_Project_ExportAll()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim bExport As Boolean
Dim sFolderPath As String
Dim sFilename As String
On Error GoTo AnError
Set VBProj = ThisWorkbook.VBProject
sFolderPath = ActiveWorkbook.Path & "\vba backup\"
For Each VBComp In VBProj.VBComponents
sFilename = VBComp.Name
bExport = True
Select Case VBComp.Type
Case vbext_ct_ClassModule
sFilename = sFilename & ".cls"
Case vbext_ct_MSForm
sFilename = sFilename & ".frm"
Case vbext_ct_StdModule
sFilename = sFilename & ".bas"
Case vbext_ct_Document
bExport = False
End Select
If (bExport = True) Then
If (Folder_Exists(sFolderPath) = False) Then
Call Folder_Create(sFolderPath, True)
End If
VBComp.Export (sFolderPath & sFilename)
End If
Next VBComp
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "VBE_Project_ExportAll", Err)
End Sub
Project_ModulesListAll
Public Sub VBE_Project_ModulesListAll()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim WS As Worksheet
Dim Rng As Range
On Error GoTo ErrorHandler
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 = VBE_Component_TypeReturn(VBComp.Type)
Set Rng = Rng(2, 1)
Next VBComp
Exit Sub
ErrorHandler:
End Sub
Project_RemoveAllVBACode
This code will delete ALL VBA code in a VBProject.Public Sub VBE_Project_RemoveAllVBACode()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
On Error GoTo ErrorHandler
Set VBProj = ActiveWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
If (VBComp.Type = vbext_ct_Document) Then
Set CodeMod = VBComp.CodeModule
CodeMod.DeleteLines 1, .CountOfLines
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
Exit Sub
ErrorHandler:
End Sub
Reference_Add
Adds a reference to the current VBA project.Public Sub VBE_ReferenceAdd(sFolderPath As String, _
sFileName As String, _
Optional bInformUser As Boolean = False)
Dim serrortext As String
On Error GoTo AnError
Application.VBE.ActiveVBProject.References.AddFromFile (sFolderPath & sFileName)
If gbDEBUG = False Then Exit Sub
AnError:
If Err.Number = 48 Then _
serrortext = "Reference name conflicts with an existing reference"
If Err.Number = 32813 Then _
serrortext = "Error in loading the reference file"
If bInformUser = True Then _
Call Error_Handle("VBE_ReferenceAdd", msMODULENAME, 1, _
"add the Visual Basic reference:" & vbCrLf & _
sFolderPath & sFileName & vbCrLf & vbCrLf & serrortext)
End Sub
Reference_Check
Checks if a reference is currently installed to that active project.Public Function VBE_ReferenceCheck(Optional sDescription As String = "", _
Optional sFullPath As String = "", _
Optional bInformUser As Boolean = False) As Boolean
Dim irefcounter As Integer
On Error GoTo AnError
VBE_ReferenceCheck = False
For irefcounter = 1 To Application.VBE.ActiveVBProject.References.Count
If sDescription <> "" Then
If Application.VBE.ActiveVBProject.References.Item(irefcounter).Description = _
sDescription Then
VBE_ReferenceCheck = True
Exit Function
End If
End If
If sFullPath <> "" Then
If Application.VBE.ActiveVBProject.References.Item(irefcounter).FullPath = _
sFullPath Then
VBE_ReferenceCheck = True
Exit Function
End If
End If
Next irefcounter
If gbDEBUG = False Then Exit Function
AnError:
VBE_ReferenceCheck = False
Call Error_Handle("VBE_ReferenceCheck", msMODULENAME, 1, _
"check if the VBA reference" & vbCrLf & _
"Description: """ & sDescription & """" & vbCrLf & _
"Folder Path: """ & sFullPath & """")
End Function
Reference_Delete
Deletes a reference from the current VBA project.Public Sub VBE_ReferenceDelete(sFolderPath As String, _
sFileName As String)
On Error GoTo AnError
Application.VBE.ActiveVBProject.References.Remove _
Application.VBE.ActiveVBProject.References.Item(sFolderPath & sFileName)
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("VBE_ReferenceDelete", msMODULENAME, 1, _
"delete the Visual Basic reference """ & sFileName & """ " & vbCrLf & _
sFolderPath)
End Sub
Reference_Path
Returns the folder path of particular installed reference.Public Function VBE_ReferencePath(sFolderPath As String, _
sFileName As String) As String
On Error GoTo AnError
' VBE_ReferencePath = _
' Application.VBE.ActiveVBProject.References.)
' test if it is built in ie standard .References().builtin
' get the description .References().Description
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("VBE_ReferencePath", msMODULENAME, 1, _
"path of the Visual Basic reference """ & sFileName & """")
End Function
© 2025 Better Solutions Limited. All Rights Reserved. © 2025 Better Solutions Limited Top