Функции для работы с объектами редактора VBA (модулями, формами, и т.п.)

' This will hide the VBE window, but you may still see it flicker.
' To prevent this, you must use the LockWindowUpdate Windows API function.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                                    (ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
 
Public Enum ProcScope
    ScopePrivate = 1: ScopePublic = 2: ScopeFriend = 3: ScopeDefault = 4
End Enum
 
Public Enum LineSplits
    LineSplitRemove = 0: LineSplitKeep = 1: LineSplitConvert = 2
End Enum
 
Public Type ProcInfo
    ProcName As String: ProcKind As VBIDE.vbext_ProcKind
    ProcStartLine As Long: ProcBodyLine As Long: ProcCountLines As Long
    ProcScope As ProcScope: ProcDeclaration As String
End Type
 
' ========= СПИСОК ФУНКЦИЙ ==============================================
'    Adding A Module To A Project
'    Adding A Procedure To A Module
'    Copy A Module From One Project To Another
'    Creating An Event Procedure
'    Deleting A Module From A Project
'    Deleting A Procedure From A Module
'    Deleting All VBA Code In A Project
'    Eliminating Screen Flicker When Working With The Visual Basic Editor
'    Exporting A VBComponent To A Text File
'    Listing All Procedures In A Module
'    Reading A Procedure Declaration
'    Searching A Module For Text
'    Testing If A VBCompoent Exists
'    Total Code Lines In A Component
'    Total Code Lines In A Project
'    Total Lines In A Project
' ========= СПИСОК ФУНКЦИЙ ==============================================

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

Sub AddProcedureToModule()
    '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.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule, LineNum As Long
    Const DQUOTE = """"    ' one " character

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

Function CopyModule(ModuleName As String, FromVBProject As VBIDE.VBProject, _
                    ToVBProject As VBIDE.VBProject, OverwriteExisting As Boolean) As Boolean
 
    'Copy A Module From One Project To Another

    'There is no direct way to copy a module from one project to another.
    'To accomplish this task, you must export the module from the Source VBProject
    'and then import that file into the Destination VBProject.

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' CopyModule
    ' This function copies a module from one VBProject to another.
    ' It returns True if successful or  False if an error occurs.
    '    The function will return False if any of the following are true:
    '        FromVBProject is nothing.
    '        ToVBProject is nothing.
    '        ModuleName is blank.
    '        FromVBProject is locked.
    '        ToVBProject is locked.
    '        ModuleName does not exist in FromVBProject.
    '        ModuleName exists in ToVBProject and OverwriteExisting is False.
    '
    ' Parameters:
    ' --------------------------------
    ' FromVBProject         The VBProject that contains the module to be copied.
    ' ToVBProject           The VBProject into which the module is to be copied.
    ' ModuleName            The name of the module to copy.
    ' OverwriteExisting     If True, the VBComponent named ModuleName in ToVBProject will be removed before importing the module.
    '                       If False and a VBComponent named ModuleName exists in ToVBProject, the code will return False.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim VBComp As VBIDE.VBComponent, FName As String, CompName As String, S As String
    Dim SlashPos As Long, ExtPos As Long, TempVBComp As VBIDE.VBComponent
 
    '''''''''''''''''''''''''''''''''''''''''''''
    ' Do some housekeeping validation.
    '''''''''''''''''''''''''''''''''''''''''''''
    If FromVBProject Is Nothing Then CopyModule = False: Exit Function
    If Trim(ModuleName) = vbNullString Then CopyModule = False: Exit Function
    If ToVBProject Is Nothing Then CopyModule = False: Exit Function
    If FromVBProject.Protection = vbext_pp_locked Then CopyModule = False: Exit Function
    If ToVBProject.Protection = vbext_pp_locked Then CopyModule = False: Exit Function
 
    On Error Resume Next
    Set VBComp = FromVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then CopyModule = False: Exit Function
 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' FName is the name of the temporary file to be
    ' used in the Export/Import code.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    FName = Environ("Temp") & "\" & ModuleName & ".bas"
    If OverwriteExisting = True Then
        ''''''''''''''''''''''''''''''''''''''
        ' If OverwriteExisting is True, Kill
        ' the existing temp file and remove
        ' the existing VBComponent from the
        ' ToVBProject.
        ''''''''''''''''''''''''''''''''''''''
        If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
            Err.Clear
            Kill FName
            If Err.Number <> 0 Then CopyModule = False: Exit Function
        End If
        With ToVBProject.VBComponents
            .Remove .Item(ModuleName)
        End With
    Else
        '''''''''''''''''''''''''''''''''''''''''
        ' OverwriteExisting is False. If there is
        ' already a VBComponent named ModuleName,
        ' exit with a return code of False.
        ''''''''''''''''''''''''''''''''''''''''''
        Err.Clear
        Set VBComp = ToVBProject.VBComponents(ModuleName)
        If Err.Number <> 0 Then
            If Err.Number = 9 Then
                ' module doesn't exist. ignore error.
            Else
                ' other error. get out with return value of False
                CopyModule = False
                Exit Function
            End If
        End If
    End If
 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Do the Export and Import operation using FName
    ' and then Kill FName.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    FromVBProject.VBComponents(ModuleName).Export FileName:=FName

    '''''''''''''''''''''''''''''''''''''
    ' Extract the module name from the
    ' export file name.
    '''''''''''''''''''''''''''''''''''''
    SlashPos = InStrRev(FName, "\")
    ExtPos = InStrRev(FName, ".")
    CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
 
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Document modules (SheetX and ThisWorkbook)
    ' cannot be removed. So, if we are working with
    ' a document object, delete all code in that
    ' component and add the lines of FName
    ' back in to the module.
    ''''''''''''''''''''''''''''''''''''''''''''''
    Set VBComp = Nothing
    Set VBComp = ToVBProject.VBComponents(CompName)
 
    If VBComp Is Nothing Then
        ToVBProject.VBComponents.Import FileName:=FName
    Else
        If VBComp.Type = vbext_ct_Document Then
            ' VBComp is destination module
            Set TempVBComp = ToVBProject.VBComponents.Import(FName)
            ' TempVBComp is source module
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                .InsertLines 1, S
            End With
            On Error GoTo 0
            ToVBProject.VBComponents.Remove TempVBComp
        End If
    End If
    Kill FName
    CopyModule = True
End Function

Sub CreateEventProcedure()
    '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.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule, 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

Sub DeleteModule()
    '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.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent
 
    Set VBProj = ActiveWorkbook.VBProject
    Set VBComp = VBProj.VBComponents("Module1")
    VBProj.VBComponents.Remove VBComp
End Sub

Sub DeleteProcedureFromModule()
    '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.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
    Dim StartLine As Long, NumLines As Long, 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

Sub DeleteAllVBACode()
    'Deleting All VBA Code In A Project
    'This code will delete ALL VBA code in a VBProject.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, 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

Sub EliminateScreenFlicker()
    'Eliminating Screen Flicker During VBProject Code
    'When you used the Extensibility code, the VBA Editor window will flicker. This can be reduced with the code:
    'Application.VBE.MainWindow.Visible = False
    Dim VBEHwnd As Long
    On Error GoTo ErrH:
    Application.VBE.MainWindow.Visible = False
    VBEHwnd = FindWindow("wndclass_desked_gsk", Application.VBE.MainWindow.Caption)
 
    If VBEHwnd Then LockWindowUpdate VBEHwnd
 
    '''''''''''''''''''''''''
    ' your code here
    '''''''''''''''''''''''''

    Application.VBE.MainWindow.Visible = False
ErrH:
    LockWindowUpdate 0&
End Sub

Public Function ExportVBComponent(VBComp As VBIDE.VBComponent, _
                                  FolderName As String, _
                                  Optional FileName As String, _
                                  Optional OverwriteExisting As Boolean = True) As Boolean
    '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.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 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, 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
 
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        If OverwriteExisting = True Then Kill FName Else ExportVBComponent = False: Exit Function
    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

Sub ListModules()
    '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.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, WS As Worksheet, 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

Sub ListProcedures()
    'Listing All Procedures In A Module
    'This code will list all the procedures in Module1, beginning the listing in cell A1.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
    Dim LineNum As Long, NumLines As Long, WS As Worksheet
    Dim Rng As Range, ProcName As String, 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
        Do Until LineNum >= .CountOfLines
            ProcName = .ProcOfLine(LineNum, ProcKind)
            Rng.Value = ProcName
            Rng(1, 2).Value = ProcKindString(ProcKind)
            LineNum = .ProcStartLine(ProcName, ProcKind) + _
                      .ProcCountLines(ProcName, ProcKind) + 1
            Set Rng = Rng(2, 1)
        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

Function ProcedureInfo(ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _
                       CodeMod As VBIDE.CodeModule) As ProcInfo
 
    'General Infomation About A Procedure
    'The code below returns the following information about a procedure in a module,loaded into the ProcInfo Type.
    'The function ProcedureInfo takes as input then name of the procedure, a VBIDE.vbext_ProcKind procedure type,
    'and a reference to the CodeModule object containing the procedure.
    Dim PInfo As ProcInfo, BodyLine As Long, Declaration As String, FirstLine As String
 
 
    BodyLine = CodeMod.ProcStartLine(ProcName, ProcKind)
    If BodyLine > 0 Then
        With CodeMod
            PInfo.ProcName = ProcName
            PInfo.ProcKind = ProcKind
            PInfo.ProcBodyLine = .ProcBodyLine(ProcName, ProcKind)
            PInfo.ProcCountLines = .ProcCountLines(ProcName, ProcKind)
            PInfo.ProcStartLine = .ProcStartLine(ProcName, ProcKind)
 
            FirstLine = .Lines(PInfo.ProcBodyLine, 1)
            If StrComp(Left(FirstLine, Len("Public")), "Public", vbBinaryCompare) = 0 Then
                PInfo.ProcScope = ScopePublic
            ElseIf StrComp(Left(FirstLine, Len("Private")), "Private", vbBinaryCompare) = 0 Then
                PInfo.ProcScope = ScopePrivate
            ElseIf StrComp(Left(FirstLine, Len("Friend")), "Friend", vbBinaryCompare) = 0 Then
                PInfo.ProcScope = ScopeFriend
            Else
                PInfo.ProcScope = ScopeDefault
            End If
            PInfo.ProcDeclaration = GetProcedureDeclaration(CodeMod, ProcName, ProcKind, LineSplitKeep)
        End With
    End If
 
    ProcedureInfo = PInfo
End Function

Public Function GetProcedureDeclaration(CodeMod As VBIDE.CodeModule, _
                                        ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _
                                        Optional LineSplitBehavior As LineSplits = LineSplitRemove)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' GetProcedureDeclaration
    ' This return the procedure declaration of ProcName in CodeMod. The LineSplitBehavior
    ' determines what to do with procedure declaration that span more than one line using
    ' the "_" line continuation character. If LineSplitBehavior is LineSplitRemove, the
    ' entire procedure declaration is converted to a single line of text. If
    ' LineSplitBehavior is LineSplitKeep the "_" characters are retained and the
    ' declaration is split with vbNewLine into multiple lines. If LineSplitBehavior is
    ' LineSplitConvert, the "_" characters are removed and replaced with vbNewLine.
    ' The function returns vbNullString if the procedure could not be found.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim LineNum As Long, S As String, Declaration As String
 
    On Error Resume Next
    LineNum = CodeMod.ProcBodyLine(ProcName, ProcKind)
    If Err.Number <> 0 Then
        Exit Function
    End If
    S = CodeMod.Lines(LineNum, 1)
    Do While Right(S, 1) = "_"
        Select Case True
            Case LineSplitBehavior = LineSplitConvert
                S = Left(S, Len(S) - 1) & vbNewLine
            Case LineSplitBehavior = LineSplitKeep
                S = S & vbNewLine
            Case LineSplitBehavior = LineSplitRemove
                S = Left(S, Len(S) - 1) & " "
        End Select
        Declaration = Declaration & S
        LineNum = LineNum + 1
        S = CodeMod.Lines(LineNum, 1)
    Loop
    Declaration = SingleSpace(Declaration & S)
    GetProcedureDeclaration = Declaration
End Function

Private Function SingleSpace(ByVal Text As String) As String
    Dim Pos As String
    Pos = InStr(1, Text, Space(2), vbBinaryCompare)
    Do Until Pos = 0
        Text = Replace(Text, Space(2), Space(1))
        Pos = InStr(1, Text, Space(2), vbBinaryCompare)
    Loop
    SingleSpace = Text
End Function

Sub ShowProcedureInfo()
    'You can call the ProcedureInfo function using code like the following:
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
    Dim CompName As String, ProcName As String, ProcKind As VBIDE.vbext_ProcKind, PInfo As ProcInfo
 
    CompName = "modMain"
    ProcName = "Main"
    ProcKind = vbext_pk_Proc
 
    Set VBProj = ActiveWorkbook.VBProject
    Set VBComp = VBProj.VBComponents(CompName)
    Set CodeMod = VBComp.CodeModule
 
    PInfo = ProcedureInfo(ProcName, ProcKind, CodeMod)
 
    Debug.Print "ProcName: " & PInfo.ProcName
    Debug.Print "ProcKind: " & CStr(PInfo.ProcKind)
    Debug.Print "ProcStartLine: " & CStr(PInfo.ProcStartLine)
    Debug.Print "ProcBodyLine: " & CStr(PInfo.ProcBodyLine)
    Debug.Print "ProcCountLines: " & CStr(PInfo.ProcCountLines)
    Debug.Print "ProcScope: " & CStr(PInfo.ProcScope)
    Debug.Print "ProcDeclaration: " & PInfo.ProcDeclaration
End Sub

Sub SearchCodeModule()
    '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.
    Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
    Dim FindWhat As String, Found As Boolean
    Dim SL As Long    ' start line
    Dim EL As Long    ' end line
    Dim SC As Long    ' start column
    Dim EC As Long    ' end column

    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

Public Function VBComponentExists(VBCompName As String, Optional VBProj As VBIDE.VBProject = Nothing) As Boolean
    'Testing If A VBComponent Exists
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 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
    On Error Resume Next
    VBComponentExists = CBool(Len(VBP.VBComponents(VBCompName).Name))
End Function

Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long
    'Total Code Lines In A Component Code Module
    '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.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 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, S As String, LineCount As Long
 
    If VBComp.Collection.Parent.Protection = vbext_pp_locked Then TotalCodeLinesInVBComponent = -1: Exit Function
 
    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

Public Function TotalLinesInProject(Optional VBProj As VBIDE.VBProject = Nothing) As Long
    '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.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This returns the total number of lines in all components of the VBProject
    ' referenced by VBProj. If VBProj is missing, the VBProject of the ActiveWorkbook
    ' is used. Returns -1 if the VBProject is locked.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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

Public Function TotalCodeLinesInProject(VBProj As VBIDE.VBProject) As Long
    '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.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This returns the total number of code lines (excluding blank lines and
    ' comment lines) in all VBComponents of VBProj. Returns -1 if VBProj
    ' is locked.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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