Visual Basic Editor (Excel)

with Ingen kommentarer

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.

Sample Code

Adding A Module To A Project

This code will add new code module named NewModule to the VBProject of the active workbook. The type of VBComponent is specified by the value of the parameter passed to the Add method.

Public Sub AddModuleToProject() 
Dim VBProj As VBIDE.VBProject 
Dim VBComp As VBIDE.VBComponent 
        
   Set VBProj = ActiveWorkbook.VBProject 
   Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule) 
   VBComp.Name = "NewModule" 
End Sub

Adding A Procedure To A Module

This code will add a simple «Hello World» procedure named SayHello to the end of the module named Module1.

    Sub AddProcedureToModule() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim CodeMod As VBIDE.CodeModule 
        Dim LineNum As Long 
        Const DQUOTE = """" ' one " character  

        Set VBProj = ActiveWorkbook.VBProject 
        Set VBComp = VBProj.VBComponents("Module1") 
        Set CodeMod = VBComp.CodeModule 
        
        With CodeMod 
            LineNum = .CountOfLines + 1 
            .InsertLines LineNum, "Public Sub SayHello()" 
            LineNum = LineNum + 1 
            .InsertLines LineNum, "    MsgBox " & DQUOTE & "Hello World" & DQUOTE 
            LineNum = LineNum + 1 
            .InsertLines LineNum, "End Sub" 
        End With

Creating An Event Procedure

This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used. CreateEventProc will create the declaration line and the end of procedure line. It returns the line number on which the event procedure begins.

    Sub CreateEventProcedure() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim CodeMod As VBIDE.CodeModule 
        Dim LineNum As Long 
        Const DQUOTE = """" ' one " character  

        Set VBProj = ActiveWorkbook.VBProject 
        Set VBComp = VBProj.VBComponents("ThisWorkbook") 
        Set CodeMod = VBComp.CodeModule 
        
        With CodeMod 
            LineNum = .CreateEventProc("Open", "Workbook") 
            LineNum = LineNum + 1 
            .InsertLines LineNum, "    MsgBox " & DQUOTE & "Hello World" & DQUOTE 
        End With 
    End Sub

Deleting A Module From A Project

This code will delete Module1 from the VBProject. Note that you cannot remove any of the Sheet modules or the ThisWorkbook module. In general, you cannot delete a module whose Type is vbext_ct_Document.

    Sub DeleteModule() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
    
        Set VBProj = ActiveWorkbook.VBProject 
        Set VBComp = VBProj.VBComponents("Module1") 
        VBProj.VBComponents.Remove VBComp 
    End Sub

Deleting A Procedure From A Module

This code will delete the procedure DeleteThisProc from the Module1. You must specify the procedure type in order to differentiate between Property Get, Property Let, and Property Set procedure, all of which have the same name.

    Sub DeleteProcedureFromModule() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim CodeMod As VBIDE.CodeModule 
        Dim StartLine As Long 
        Dim NumLines As Long 
        Dim ProcName As String 
        
        Set VBProj = ActiveWorkbook.VBProject 
        Set VBComp = VBProj.VBComponents("Module1") 
        Set CodeMod = VBComp.CodeModule 
    
        ProcName = "DeleteThisProc" 
        With CodeMod 
            StartLine = .ProcStartLine(ProcName, vbext_pk_Proc) 
            NumLines = .ProcCountLines(ProcName, vbext_pk_Proc) 
            .DeleteLines StartLine:=StartLine, Count:=NumLines 
        End With 
    End Sub

Deleting All VBA Code In A Project

This code will delete ALL VBA code in a VBProject.

    Sub DeleteAllVBACode() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim CodeMod As VBIDE.CodeModule 
        
        Set VBProj = ActiveWorkbook.VBProject 
        
        For Each VBComp In VBProj.VBComponents 
            If VBComp.Type = vbext_ct_Document Then 
                Set CodeMod = VBComp.CodeModule 
                With CodeMod 
                    .DeleteLines 1, .CountOfLines 
                End With 
            Else 
                VBProj.VBComponents.Remove VBComp 
            End If 
        Next VBComp 
    End Sub

Exporting a VBComponent Code Module To A Text File

You can export an existing VBComponent CodeModule to a text file. This can be useful if you are archiving modules to create a library of useful module to be used in other projects.

    Public Function ExportVBComponent(VBComp As VBIDE.VBComponent, _ 
                FolderName As String, _ 
                Optional FileName As String, _ 
                Optional OverwriteExisting As Boolean = True) As Boolean 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This function exports the code module of a VBComponent to a text
    ' file. If FileName is missing, the code will be exported to
    ' a file with the same name as the VBComponent followed by the
    ' appropriate extension.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Extension As String 
    Dim FName As String 
    Extension = GetFileExtension(VBComp:=VBComp) 
    If Trim(FileName) = vbNullString Then 
        FName = VBComp.Name & Extension 
    Else 
        FName = FileName 
        If InStr(1, FName, ".", vbBinaryCompare) = 0 Then 
            FName = FName & Extension 
        End If 
    End If 
    
    If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then 
        FName = FolderName & FName 
    Else 
        FName = FolderName & "\" & FName 
    End If 
    
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then 
        If OverwriteExisting = True Then 
            Kill FName 
        Else 
            ExportVBComponent = False 
            Exit Function 
        End If 
    End If 
    
    VBComp.Export FileName:=FName 
    ExportVBComponent = True 
    
    End Function 
    
    Public Function GetFileExtension(VBComp As VBIDE.VBComponent) As String 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This returns the appropriate file extension based on the Type of
    ' the VBComponent.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Select Case VBComp.Type 
            Case vbext_ct_ClassModule 
                GetFileExtension = ".cls" 
            Case vbext_ct_Document 
                GetFileExtension = ".cls" 
            Case vbext_ct_MSForm 
                GetFileExtension = ".frm" 
            Case vbext_ct_StdModule 
                GetFileExtension = ".bas" 
            Case Else 
                GetFileExtension = ".bas" 
        End Select 
        
    End Function

Listing All Modules In A Project

This code will list all the modules and their types in the workbook, starting the listing in cell A1.

    Sub ListModules() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim WS As Worksheet 
        Dim Rng As Range 
        
        Set VBProj = ActiveWorkbook.VBProject 
        Set WS = ActiveWorkbook.Worksheets("Sheet1") 
        Set Rng = WS.Range("A1") 
        
        For Each VBComp In VBProj.VBComponents 
            Rng(1, 1).Value = VBComp.Name 
            Rng(1, 2).Value = ComponentTypeToString(VBComp.Type) 
            Set Rng = Rng(2, 1) 
        Next VBComp 
    End Sub
    Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String 
        Select Case ComponentType 
            Case vbext_ct_ActiveXDesigner 
                ComponentTypeToString = "ActiveX Designer" 
            Case vbext_ct_ClassModule 
                ComponentTypeToString = "Class Module" 
            Case vbext_ct_Document 
                ComponentTypeToString = "Document Module" 
            Case vbext_ct_MSForm 
                ComponentTypeToString = "UserForm" 
            Case vbext_ct_StdModule 
                ComponentTypeToString = "Code Module" 
            Case Else 
                ComponentTypeToString = "Unknown Type: " & CStr(ComponentType) 
        End Select 
    End Function

Listing All Procedures In A Module

This code will list all the procedures in Module1, beginning the listing in cell A1.

    Sub ListProcedures() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim CodeMod As VBIDE.CodeModule 
        Dim LineNum As Long 
        Dim NumLines As Long 
        Dim WS As Worksheet 
        Dim Rng As Range 
        Dim ProcName As String 
        Dim ProcKind As VBIDE.vbext_ProcKind 
        
        Set VBProj = ActiveWorkbook.VBProject 
        Set VBComp = VBProj.VBComponents("Module1") 
        Set CodeMod = VBComp.CodeModule 
        
        Set WS = ActiveWorkbook.Worksheets("Sheet1") 
        Set Rng = WS.Range("A1") 
        
        With CodeMod 
            LineNum = .CountOfDeclarationLines + 1 
            ProcName = .ProcOfLine(LineNum, ProcKind) 
            Do Until LineNum >= .CountOfLines 
                Rng(1, 1).Value = ProcName 
                Rng(1, 2).Value = ProcKindString(ProcKind) 
                
                Set Rng = Rng(2, 1) 
                LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) + 1 
                
                ProcName = .ProcOfLine(LineNum, ProcKind) 
            Loop 
        End With 
    End Sub 
       
    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String 
        Select Case ProcKind 
            Case vbext_pk_Get 
                ProcKindString = "Property Get" 
            Case vbext_pk_Let 
                ProcKindString = "Property Let" 
            Case vbext_pk_Set 
                ProcKindString = "Property Set" 
            Case vbext_pk_Proc 
                ProcKindString = "Sub Or Function" 
            Case Else 
                ProcKindString = "Unknown Type: " & CStr(ProcKind) 
        End Select 
    End Function

Searching For Text In A Module

The CodeModule object has a Find method that you can use to search for text within the code module. The Find method accepts ByRef Long parameters. Upon input, these parameters specify the range of lines and column to search. On output, these values will point to the found text. To find the second and subsequent occurence of the text, you need to set the parameters to refer to the text following the found line and column. The Find method returns True or False indicating whether the text was found. The code below will search all of the code in Module1 and print a Debug message for each found occurrence. Note the values set with the SL, SC, EL, and EC variables. The code loops until the Found variable is False.

Sub SearchCodeModule() 
        Dim VBProj As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim CodeMod As VBIDE.CodeModule 
        Dim FindWhat As String 
        Dim SL As Long ' start line  
        Dim EL As Long ' end line  
        Dim SC As Long ' start column  
        Dim EC As Long ' end column  
        Dim Found As Boolean 
        
        Set VBProj = ActiveWorkbook.VBProject 
        Set VBComp = VBProj.VBComponents("Module1") 
        Set CodeMod = VBComp.CodeModule 
        
        FindWhat = "findthis" 
        
        With CodeMod 
            SL = 1 
            EL = .CountOfLines 
            SC = 1 
            EC = 255 
            Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _ 
                EndLine:=EL, EndColumn:=EC, _ 
                wholeword:=True, MatchCase:=False, patternsearch:=False) 
            Do Until Found = False 
                Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC) 
                EL = .CountOfLines 
                SC = EC + 1 
                EC = 255 
                Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _ 
                    EndLine:=EL, EndColumn:=EC, _ 
                    wholeword:=True, MatchCase:=False, patternsearch:=False) 
            Loop 
        End With 
    End Sub

Testing If A VBComponent Exists

This code will return True or False indicating whether the VBComponent named by VBCompName exists in the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used.

 

    Public Function VBComponentExists(VBCompName As String, Optional VBProj As VBIDE.VBProject = Nothing) As Boolean 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This returns True or False indicating whether a VBComponent named
    ' VBCompName exists in the VBProject referenced by VBProj. If VBProj
    ' is omitted, the VBProject of the ActiveWorkbook is used.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim VBP As VBIDE.VBProject 
        If VBProj Is Nothing Then 
            Set VBP = ActiveWorkbook.VBProject 
        Else 
            Set VBP = VBProj 
        End If 
        On Error Resume Next 
        VBComponentExists = CBool(Len(VBP.VBComponents(VBCompName).Name)) 
    
End Function

Total Code Lines In A Component

This function will return the total code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.

    Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This returns the total number of code lines (excluding blank lines and
    ' comment lines) in the VBComponent referenced by VBComp. Returns -1
    ' if the VBProject is locked.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim N As Long 
        Dim S As String 
        Dim LineCount As Long 
        
        If VBComp.Collection.Parent.Protection = vbext_pp_locked Then 
            TotalCodeLinesInVBComponent = -1 
            Exit Function 
        End If 
        
        With VBComp.CodeModule 
            For N = 1 To .CountOfLines 
                S = .Lines(N, 1) 
                If Trim(S) = vbNullString Then 
                    ' blank line, skip it
                ElseIf Left(Trim(S), 1) = "'" Then  
                    ' comment line, skip it
                Else 
                    LineCount = LineCount + 1 
                End If 
            Next N 
        End With 
        TotalCodeLinesInVBComponent = LineCount 
    End Function

Total Lines In A Project

This code will return the count of lines in all components of the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used. The function will return -1 if the project is locked.

    Public Function TotalLinesInProject(Optional VBProj As VBIDE.VBProject = Nothing) As Long 
    
        Dim VBP As VBIDE.VBProject 
        Dim VBComp As VBIDE.VBComponent 
        Dim LineCount As Long 
        
        If VBProj Is Nothing Then 
            Set VBP = ActiveWorkbook.VBProject 
        Else 
            Set VBP = VBProj 
        End If 
        
        If VBP.Protection = vbext_pp_locked Then 
            TotalLinesInProject = -1 
            Exit Function 
        End If 
        
        For Each VBComp In VBP.VBComponents 
            LineCount = LineCount + VBComp.CodeModule.CountOfLines 
        Next VBComp 
        
        TotalLinesInProject = LineCount 
    End Function

Total Code Lines In A Component

This function will return the total number of code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.

 

    Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long 
        Dim N As Long 
        Dim S As String 
        Dim LineCount As Long 
        
        If VBComp.Collection.Parent.Protection = vbext_pp_locked Then 
            TotalCodeLinesInVBComponent = -1 
            Exit Function 
        End If 
        
        With VBComp.CodeModule 
            For N = 1 To .CountOfLines 
                S = .Lines(N, 1) 
                If Trim(S) = vbNullString Then 
                    ' blank line, skip it
                ElseIf Left(Trim(S), 1) = "'" Then  
                    ' comment line, skip it
                Else 
                    LineCount = LineCount + 1 
                End If 
            Next N 
        End With 
        TotalCodeLinesInVBComponent = LineCount 
    End Function

Total Code Lines In A Project

This function will return the total number of code lines in all the components of a VBProject. It ignores blank lines and comment lines. It will return -1 if the project is locked.

 

    Public Function TotalCodeLinesInProject(VBProj As VBIDE.VBProject) As Long 
        
        Dim VBComp As VBIDE.VBComponent 
        Dim LineCount As Long 
        If VBProj.Protection = vbext_pp_locked Then 
            TotalCodeLinesInProject = -1 
            Exit Function 
        End If 
        For Each VBComp In VBProj.VBComponents 
            LineCount = LineCount + TotalCodeLinesInVBComponent(VBComp) 
        Next VBComp 
        
        TotalCodeLinesInProject = LineCount 
    End Function

Procnames Function

Function to return the names of Procedures in a given module

Function ProcNames(ByRef strMName As String) As String() 
    Dim lngSLine As Long                       '   Line Number  
    Dim vbCodeMod As CodeModule     '   Object for Code Module  
    Dim intPCount As Integer                  '   Procedure Count  
    Dim pnamearray() As String              '   Procedure Names Array  
'   Set named module as module object
    Set vbCodeMod = ThisWorkbook.VBProject.VBComponents(strMName).CodeModule 
'   Scan through module looking for Declaration lines
'   and set up array of macro names as we go
    With vbCodeMod 
        lngSLine = .CountOfDeclarationLines + 1 
        Do Until lngSLine >= .CountOfLines 
            intPCount = intPCount + 1 
            ReDim Preserve pnamearray(intPCount) 
            pnamearray(intPCount) = .ProcOfLine(lngSLine, vbext_pk_Proc) 
            lngSLine = lngSLine + .ProcCountLines(.ProcOfLine(lngSLine, vbext_pk_Proc), vbext_pk_Proc) 
        Loop 
    End With 
'   Return array of Procedure names
    ProcNames = pnamearray() 
End Function

ModExist Function

This function test to see if a given VBA module exists in the current project.

Function ModExist(strModName As String) As Boolean 
    Dim intVBCcnt As Integer 
    Dim intVBDcnt As Integer 
    Dim intLC1 As Integer 
'   Set up count of modules in project 
    intVBCcnt = ThisWorkbook.VBProject.VBComponents.Count 
    intVBDcnt = 0 
'   Loop through module names 
    For intLC1 = 1 To intVBCcnt 
        If ThisWorkbook.VBProject.VBComponents(intLC1).Type = vbext_ct_StdModule Then 
            If ThisWorkbook.VBProject.VBComponents(intLC1).Name = strModName Then 
                ModExist = True 
                GoTo Exit_ModExist 
            End If 
        End If 
    Next intLC1 
    ModExist = False 
Exit_ModExist: 
End Function