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_Export

Exports a component to a folder from a VBE project.

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

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

Module_Add

Adds a blank VBA module to a project.

Public Sub VBE_ModuleAdd(sModuleName As String, _
                         Optional sDocName As String = "")
Dim modFormModule As VBComponent
   On Error GoTo AnError
   If sDocName = "" Then sDocName = ActiveDocument.Name
   Set modFormModule = Documents(sDocName).VBProject.VBComponents.Add(vbext_ct_StdModule)
   modFormModule.Name = sModuleName
   If gbDEBUG = False Then Exit Sub
AnError:
   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_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 ther 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_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_ProcedureRemove

Removes a particular procedure from a code module.

Public Function VBE_ModuleProcedureRemove(vbModuleComp As VBIDE.VBComponent, _
                                          sProcedureName As String) As Boolean
Dim lstartline As Long
Dim lnooflines As Long
   On Error GoTo AnError
   With vbModuleComp.CodeModule
      lstartline = .ProcStartLine(sProcedureName, vbext_pk_Proc)
      lnooflines = .ProcCountLines(sProcedureName, vbext_pk_Proc)
      .DeleteLines lstartline, lnooflines
   End With
   
   If gbDEBUG = False Then Exit Function
AnError:
   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

Module_Remove

Deletes a VBA module from the active project.

Public Sub VBE_ModuleRemove(sModuleName As String, _
                 Optional sDocName As String = "")
   On Error GoTo AnError
   Documents(sDocName).VBProject.VBComponents.Remove _
       Documents(sDocName).VBProject.VBComponents(sModuleName)
   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle("VBE_ModuleRemove", msMODULENAME, 1, _
        "module " & sModuleName & " from the document " & sDocName)
End Sub

Projects_VBAProject_Export

Public Sub VBAProject_Export()

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, "KillProperly", Err)
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

---

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