Code 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 ErrorHandler

   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
ErrorHandler:
   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 ErrorHandler
   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sLabelCaption As String, _
         ByVal sLabelName As String, _
         ByVal iLabelHeight As Integer, _
         ByVal iLabelLeft As Integer, _
         ByVal iLabelTop As Integer, _
         ByVal iLabelWidth As Integer, _
         ByVal sCodeOnClick As String)

Dim vbcFormName 'As VBComponent
Dim label As MSForms.label

   On Error GoTo ErrorHandler
   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sListBoxName As String, _
         ByVal ilistboxwidth As Integer, _
         ByVal ilistboxheight As Integer, _
         ByVal ilistboxleft As Integer, _
         ByVal ilistboxtop As Integer)

Dim vbcFormName 'As VBComponent
Dim listbox As MSForms.listbox
Dim vno As Variant

   On Error GoTo ErrorHandler
   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sOptionButtonCaption As String, _
         ByVal sOptionButtonName As String, _
         ByVal iOptionButtonHeight As Integer, _
         ByVal iOptionButtonLeft As Integer, _
         ByVal iOptionButtonTop As Integer, _
         ByVal iOptionButtonWidth As Integer, _
         ByVal  sCodeOnClick As String)

Dim vbcFormName 'As VBComponent
Dim optionbutton As MSForms.optionbutton

   On Error GoTo ErrorHandler
   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sTextBoxCaption As String, _
         ByVal sTextBoxName As String, _
         ByVal iTextBoxHeight As Integer, _
         ByVal iTextBoxLeft As Integer, _
         ByVal iTextBoxTop As Integer, _
         ByVal iTextBoxWidth As Integer, _
         ByVal sCodeOnClick As String, _
Optional ByVal sDefaultText As String = "")

Dim vbcFormName 'As VBComponent
Dim textbox As MSForms.textbox

   On Error GoTo ErrorHandler
   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
ErrorHandler:
   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 ErrorHandler


   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal sComponentName As String, _
         ByVal sFolderPath As String, _
         ByVal sFileName As String, _
         ByVal sExtension As String)

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFormName As String) _
         As String

Dim frmTempForm 'As VBComponent

   On Error GoTo ErrorHandler

   
   If gbDEBUG = False Then Exit Function
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sControlName As String, _
         ByVal iCtrlLeft As Integer, _
         ByVal iCtrlTop As Integer)

Dim vbcFormName 'As VBComponent
Dim imagecontrol As MSForms.Image

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sControlName As String, _
         ByVal iCtrlHeight As Integer, _
         ByVal iCtrlWidth As Integer)

Dim vbcFormName 'As VBComponent
Dim imagecontrol As MSForms.Image

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFormName As String)

   On Error GoTo ErrorHandler
   ActiveDocument.VBProject.VBComponents.Remove _
             VBComponent:=ActiveDocument.VBProject.VBComponents(sFormName)

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal sFormName As String)

Dim vbcFormName 'As VBComponent
Dim eachcontrol As MSForms.control

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal sImageToShow As String, _
         ByVal iMessageBoxHeight As Integer)

Dim vbcFormName 'As VBComponent
Dim imagecontrol As MSForms.Image

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFormName As String)

Dim vbcFormName 'As VBComponent

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal bModal As Boolean)

Dim mlHWnd As Long

   On Error GoTo ErrorHandler
                                                       '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
ErrorHandler:
   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( _
         ByVal sFormName As String) _
         As String

   On Error GoTo ErrorHandler

   VBA.Userforms.Add(ActiveDocument.VBProject.VBComponents(sFormName).Name).Show

   If gbDEBUG = False Then Exit Function
ErrorHandler:
   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( _
         ByVal sFormName As String, _
         ByVal iFormHeight As Integer, _
         ByVal iFormWidth As Integer, _
         ByVal sTitle As String) _
         As String

Dim vbcFormName 'As VBComponent

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sFolderPath As String, _
         ByVal sFileName As String)

   On Error GoTo ErrorHandler

   ActiveDocument.VBProject.VBComponents.Import sFolderPath & sFileName
   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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 ErrorHandler


   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal vbComp As VBIDE.VBComponent) _
         As String

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sComponentName As String, _
         ByVal sCodeToAdd As String, _
Optional ByVal sDocName As String = "", _
Optional ByVal 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( _
         ByVal vbModuleComp As VBIDE.VBComponent, _
         ByVal sProcedureName As String, _
         ByVal sProcedureCode As String) _
         As Boolean

Dim lstartline As Long
Dim lnooflines As Long

   On Error GoTo ErrorHandler
   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
ErrorHandler:
   Call Error_Handle("VBE_ModuleCodeAdd", msMODULENAME, 1, _
        "")
End Function

Module_CodeDeleteAll

Public Sub VBE_CodeDeleteAll( _
         ByVal sComponentName As String)

Dim modFormModule As CodeModule

   On Error GoTo ErrorHandler

   Set modFormModule = ActiveDocument.VBProject.VBComponents(sComponentName).CodeModule
   modFormModule.DeleteLines 1, modFormModule.CountOfLines
   
   Set modFormModule = Nothing

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal sComponentName As String, _
         ByVal 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
ErrorHandler:
   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( _
         ByVal sCodeToAdd As String, _
Optional ByVal sDocName As String = "") _
         As Boolean

Dim modCodeModule
Dim lcurrenttotallines As Long

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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( _
         ByVal sCodeToAdd As String, _
Optional ByVal sDocName As String = "") _
         As Boolean

Dim modCodeModule
Dim lcurrenttotallines As Long

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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 ErrorHandler

   Set modCodeModule = Documents(sDocName).VBProject. _
               VBComponents("ThisDocument").CodeModule
                       
   modCodeModule.DeleteLines 1, modCodeModule.CountOfLines
   Set modCodeModule = Nothing

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal sModuleName As String, _
         ByVal sFolderPath As String, _
         ByVal sFileName As String, _
Optional ByVal sDocName As String = "")

   On Error GoTo ErrorHandler

   If sDocname = "" Then sDocName = ActiveDocument.Name
   Documents(sDocName) .VBProject.VBComponents(sModuleName).Export _
         FileName:=sFolderPath & sFileName

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal sFolderPath As String, _
         ByVal sFileName As String, _
Optional ByVal sDocName As String = "")

   On Error GoTo ErrorHandler

   If sDocName = "" Then sDocName = ActiveDocument.Name
   Documents(sDocName).VBProject.VBComponents.Import sFolderPath & sFileName

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal vbModuleComp As VBIDE.VBComponent, _
Optional ByVal sSeperatorChar As String = ",") _
         ByVal As String

Dim lstartline As Long
Dim lnooflines As Long
Dim stext As String

   On Error GoTo ErrorHandler

   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
ErrorHandler:
   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 ErrorHandler

   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
    
ErrorHandler:
   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( _
         ByVal sFolderPath As String, _
         ByVal sFileName As String, _
Optional bInformUser As Boolean = False)

Dim serrortext As String

   On Error GoTo ErrorHandler

   Application.VBE.ActiveVBProject.References.AddFromFile (sFolderPath & sFileName)

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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 ByVal sDescription As String = "", _
Optional ByVal sFullPath As String = "", _
Optional ByVal 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

ErrorHandler:
   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( _
         ByVal sFolderPath As String, _
         ByVal sFileName As String)

   On Error GoTo ErrorHandler

   Application.VBE.ActiveVBProject.References.Remove _
      Application.VBE.ActiveVBProject.References.Item(sFolderPath & sFileName)

   If gbDEBUG = False Then Exit Sub
ErrorHandler:
   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( _
         ByVal sFolderPath As String, _
         ByVal sFileName As String) _
         As String

   On Error GoTo ErrorHandler
'   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
ErrorHandler:
   Call Error_Handle("VBE_ReferencePath", msMODULENAME, 1, _
        "path of the Visual Basic reference """ & sFileName & """")
End Function

---

© 2026 Better Solutions Limited. All Rights Reserved. © 2026 Better Solutions Limited Top