VBA TIPS
Generating a list of Modules and Procedures

This program would generate a list of the Modules and the Procedures in the opened workbooks.



Place the following in the standard module.

Option Explicit

'Need the declaration for the following constants or
'check the reference to Microfost Visual Basic for Applications Extensbility x.xx

Const vbext_pp_none As Long = 0
Const vbext_pk_Proc As Long = 0

Dim x As Long
Dim aList()

Sub GetVbProj()
    Dim oVBC As Object
    Dim Wb As Workbook
    x = 2
    For Each Wb In Workbooks
        For Each oVBC In Workbooks(Wb.Name).VBProject.VBComponents
            If Workbooks(Wb.Name).VBProject.Protection = vbext_pp_none Then
                Call GetCodeRoutines(Wb.Name, oVBC.Name)
            End If
        Next
    Next
    With Sheets.Add
        .[A1].Resize(, 3).Value = Array("Workbook", "Module", "Procedure")
        .[A2].Resize(UBound(aList, 2)UBound(aList, 1)).Value = _
        Application.Transpose(aList)
        .Columns("A:C").Columns.AutoFit
    End With
End Sub

Private Sub GetCodeRoutines(wbk As String, VBComp As String)
    Dim VBCodeMod As Object
    Dim StartLine As Long

    On Error Resume Next
    Set VBCodeMod = Workbooks(wbk).VBProject.VBComponents(VBComp).CodeModule
    With VBCodeMod
        StartLine = .CountOfDeclarationLines + 1
        Do Until StartLine >= .CountOfLines
            ReDim Preserve aList(1 To 3, 1 To x - 1)
            aList(1, x - 1) = wbk
            aList(2, x - 1) = VBComp
            aList(3, x - 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
            x = x + 1
            StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _
                                            vbext_pk_Proc), vbext_pk_Proc)
            If Err Then Exit Sub
        Loop
    End With
    Set VBCodeMod = Nothing
End Sub





| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
ABOUT
WORKS
THE CELL MASTERS
CONTACT
LINKS
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo