Listing Names of Subs & Functions

Hi,
I want to create a "Library"/directory of VB code. But I'm stuck on two points (I dont know if there's already a tool for doing this so I've started to make one of my own)

The code below returns all the VB components in the active workbook. This is fine if all the modules have been named after the procedure contained in it, but it's not always practical as a single module may contain several other private or public subs or functions - one of which might be the one I'm looking for (on top of which, some modules may just be named "module1" or 2) so I really need something that returns all the individual subs in each module as well - Any suggestions?

Ideally, instead of just the active workbook, I should also be able to get a list (and the path of course) of the subs in all workbooks...but how do I access those books without opening them all and causing a memory overflow? :bink:


'This lists all VB components in a 3 column list box

Code:

---

Private Sub UserForm_activate()
Dim N As Integer, MyList(100, 3) 'as array type
'//headings
MyList(0, 0) = "COMPONENT NAME"
MyList(0, 1) = "COMPONENT TYPE"
MyList(0, 2) = "BOOK NAME"
'//define list
For N = 1 To ActiveWorkbook.VBProject.VBcomponents.Count
MyList(N, 0) = ActiveWorkbook.VBProject.VBcomponents(N).Name
MyList(N, 1) = ActiveWorkbook.VBProject.VBcomponents(N).Type
MyList(N, 2) = ActiveWorkbook.Name
'//change type from a number to a name
If MyList(N, 1) = 1 Then MyList(N, 1) = "Basic Module"
If MyList(N, 1) = 2 Then MyList(N, 1) = "Class Module"
If MyList(N, 1) = 3 Then MyList(N, 1) = "UserForm"
If MyList(N, 1) = 100 Then MyList(N, 1) = "Book/Sheet Class Module)"
Next N
'//load list to listbox
ListBox1.List = MyList
End Sub

---

'This is optional - used if a 'hard copy' list of components is wanted

Code:

---

Private Sub CommandButton1_Click()
Dim N As Integer
'//add a new work sheet
Application.ScreenUpdating = False
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
'//add headings to the sheet
Range("A1") = "COMPONENT NAME"
Range("B1") = "COMPONENT TYPE"
Range("C1") = "BOOK NAME"
'//add list to the sheet
For N = 1 To ActiveWorkbook.VBProject.VBcomponents.Count
Range("A" & N + 1) = ActiveWorkbook.VBProject.VBcomponents(N).Name
Range("B" & N + 1) = ActiveWorkbook.VBProject.VBcomponents(N).Type
Range("C" & N + 1) = ActiveWorkbook.Name
'//change type from a number to a name
If Range("B" & N + 1) = 1 Then Range("B" & N + 1) = "Basic Module"
If Range("B" & N + 1) = 2 Then Range("B" & N + 1) = "Class Module"
If Range("B" & N + 1) = 3 Then Range("B" & N + 1) = "UserForm"
If Range("B" & N + 1) = 100 Then Range("B" & N + 1) = "Book/Sheet Class Module)"
Next N
ActiveSheet.Columns("A:C").EntireColumn.AutoFit
Unload Me
End Sub

---

Hi John,

Is this the sort of thing that you mean?

Code:

---

Sub Test()
    Dim wbk As Workbook
    Dim VBComp As VBComponent
    Dim Msg As String
Set wbk = ThisWorkbook
For Each VBComp In wbk.VBProject.VBComponents
        Msg = Msg & ListProcedures(wbk, VBComp.Name)
    Next VBComp
    MsgBox Msg
End Sub

Function ListProcedures(wbk As Workbook, strModName As String) As String
'add a reference to VBA Extensibility library
    Dim VBCodeMod As CodeModule
    Dim StartLine As Long
    Dim strTemp As String
Set VBCodeMod = wbk.VBProject.VBComponents(strModName).CodeModule
    With VBCodeMod
        StartLine = .CountOfDeclarationLines + 1
        Do Until StartLine >= .CountOfLines
            strTemp = strTemp & .ProcOfLine(StartLine, vbext_pk_Proc) & vbNewLine
            StartLine = StartLine + _
              .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
        Loop
    End With
    ListProcedures = strTemp
End Function

---

A nice reference for this sort of thing is Chip Pearson's page here:
http://www.cpearson.com/excel/vbe.htm

HTH

Cool Richie, thanx very much for that !! :vv

All I gotta do now is work out exactly wot's bein dun and insert that in an inner loop in the list box loop.

. :bink:

Not sure if it helps, John, but for my use I just combined the two subroutines for my own personal use (thanks you two, this could be quite useful!)

Code:

---

Private Sub ModuleBreakdown()
 Dim N As Integer, i As Long, T As Integer
 Dim VBC As VBComponent, sTmp As String, WB As Workbook
 Application.ScreenUpdating = False
 If ActiveWorkbook Is Nothing Then Workbooks.add Else Sheets.add after:=Sheets(Sheets.Count)
 Range("A1") = "COMPONENT NAME"
 Range("B1") = "COMPONENT TYPE"
 Range("C1") = "BOOK NAME"
 Range("D1") = "PROCEDURES"
 N = 2
 For Each VBC In ThisWorkbook.VBProject.VBComponents
  Range("A" & N) = VBC.Name
  T = VBC.Type
  If T = 1 Then Range("B" & N) = "Basic Module"
  If T = 2 Then Range("B" & N) = "Class Module"
  If T = 3 Then Range("B" & N) = "UserForm"
  If T = 11 Then Range("B" & N) = "ActiveX"
  If T = 100 Then Range("B" & N) = "Book/Sheet Class Module"
  Range("C" & N) = ThisWorkbook.Name
  With VBC.CodeModule
  i = .CountOfDeclarationLines + 1
  sTmp = ""
  Do Until i >= .CountOfLines
    Range("D" & N) = .ProcOfLine(i, vbext_pk_Proc)
    i = i + .ProcCountLines(.ProcOfLine(i, vbext_pk_Proc), vbext_pk_Proc)
    If i < .CountOfLines Then N = N + 1
  Loop
  End With
  N = N + 1
 Next
 Columns.AutoFit
 Application.ScreenUpdating = True
End Sub

---

Matt

Thanx Matt,

That's almost exactly wot I'm after. ;) Only difference is that I'd prefer to see it in a list box first, listing it on the page being an option - I can sort it from there though, no probs.. :bink:

{The only thing left to sort is if I can access all the other workbooks (other than the one(s) that are open) - If not, it's still a big help cos I can import mosta the modules into one (or two) workbooks anyway and keep that/them as a "library"}

Do you mean all the workbooks in a specific directory, or the open workbooks other than ActiveWorkbook and ThisWorkbook?

Here's your original code with the module names


'This lists all VB components in a 3 column list box

Code:

---

Private Sub UserForm_activate()
Dim N As Integer, MyList(100, 4) As Variant, i As Long, T As Integer
Dim VBC, sTmp As String, WB As Workbook
'//headings
MyList(0, 0) = "COMPONENT NAME"
MyList(0, 1) = "COMPONENT TYPE"
MyList(0, 2) = "BOOK NAME"
MyList(0, 3) = "PROCEDURES"
'//define list
N = 1
For Each VBC In ActiveWorkbook.VBProject.VBComponents
MyList(N, 0) = VBC.Name
T = VBC.Type
If T = 1 Then MyList(N, 1) = "Basic Module"
If T = 2 Then MyList(N, 1) = "Class Module"
If T = 3 Then MyList(N, 1) = "UserForm"
If T = 11 Then MyList(N, 1) = "ActiveX"
If T = 100 Then MyList(N, 1) = "Book/Sheet Class Module"
MyList(N, 2) = ActiveWorkbook.Name
With VBC.codemodule
i = .CountOfDeclarationLines + 1
sTmp = ""
Do Until i >= .CountOfLines
MyList(N, 3) = .ProcOfLine(i, vbext_pk_Proc)
i = i + .ProcCountLines(.ProcOfLine(i, vbext_pk_Proc), vbext_pk_Proc)
If i < .CountOfLines Then N = N + 1
Loop
End With
N = N + 1
Next
'//load list to listbox
ListBox1.List = MyList
End Sub

---

'This is optional - used if a 'hard copy' list of components is wanted

Code:

---

Private Sub CommandButton1_Click()
Dim N As Integer, i As Long, T As Integer
Dim VBC As VBComponent, sTmp As String, WB As Workbook
Application.ScreenUpdating = False
If ActiveWorkbook Is Nothing Then Workbooks.Add Else Sheets.Add After:=Sheets(Sheets.Count)
Range("A1") = "COMPONENT NAME"
Range("B1") = "COMPONENT TYPE"
Range("C1") = "BOOK NAME"
Range("D1") = "PROCEDURES"
N = 2
For Each VBC In ThisWorkbook.VBProject.VBComponents
Range("A" & N) = VBC.Name
T = VBC.Type
If T = 1 Then Range("B" & N) = "Basic Module"
If T = 2 Then Range("B" & N) = "Class Module"
If T = 3 Then Range("B" & N) = "UserForm"
If T = 11 Then Range("B" & N) = "ActiveX"
If T = 100 Then Range("B" & N) = "Book/Sheet Class Module"
Range("C" & N) = ThisWorkbook.Name
With VBC.codemodule
i = .CountOfDeclarationLines + 1
sTmp = ""
Do Until i >= .CountOfLines
Range("D" & N) = .ProcOfLine(i, vbext_pk_Proc)
i = i + .ProcCountLines(.ProcOfLine(i, vbext_pk_Proc), vbext_pk_Proc)
If i < .CountOfLines Then N = N + 1
Loop
End With
N = N + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
Unload Me
End Sub

---

Again, let me know about the workbooks and I can try and modify that for you

Hi all,
Another thing which would be useful is a note of the shortcut key (if any), which goes with each macro. I know it can be retreived if noted as a comment at the start of the code, but can it be done if it's not there?
MD

Thats a good question, I think I remember reading about something like that not too long ago
Let me see if I can find it

Matt, that's a slick rendition. :yes I'll find that very useful. :D

Nice job fellas!

All I did was combine code pretty much :) I had created an answer for this, but it was much worse than Richie's/Chip's method (I was going through the code line by line and assigning the proc name to a collection)

I'm --> <-- this close to solving the keyboard shortcut idea, the shortcut is listed in the exported module. BUT, now I'm just trying to see if theres a way to export the module to a string variable so I don't have to create a temporary file on the user's computer. I may have to go that route, but I'm hoping not

I should have an answer soon, hopefully

Hi there,

mvidas, don't know if this will help, but just recorded this:

Code:

---

Application.MacroOptions Macro:="PERSONAL.XLS!Macro1", Description:="", _
        ShortcutKey:="B"

---

Was thinking you could maybe loop and compare macro names to macro options...

Cheers,

Hey Matt,

This seems to work for me to go through all open workbooks. This will take into account any hidden sheets e.g. Personal.xls ...

Code:

---

Sub ShowAllModules()
    Application.ScreenUpdating = False
    Dim N As Integer, i As Long, T As Integer
    Dim VBC As VBComponent, sTmp As String, wb As Workbook
    Dim myBook As Workbook, mySheet As Worksheet, currBook As Workbook
    Set currBook = ActiveWorkbook
    If ActiveWorkbook Is Nothing Then
        Workbooks.Add
        Set myBook = ActiveWorkbook
        Set mySheet = myBook.ActiveSheet
    Else
        Sheets.Add after:=Sheets(Sheets.Count)
        Set myBook = ActiveWorkbook
        Set mySheet = myBook.ActiveSheet
    End If
    mySheet.Range("A1") = "COMPONENT NAME"
    mySheet.Range("B1") = "COMPONENT TYPE"
    mySheet.Range("C1") = "BOOK NAME"
    mySheet.Range("D1") = "PROCEDURES"
    N = 2
    For Each wb In oExcel.Workbooks
        wb.Activate
        For Each VBC In ActiveWorkbook.VBProject.VBComponents
            mySheet.Range("A" & N) = VBC.name
            T = VBC.Type
            If T = 1 Then mySheet.Range("B" & N) = "Basic Module"
            If T = 2 Then mySheet.Range("B" & N) = "Class Module"
            If T = 3 Then mySheet.Range("B" & N) = "UserForm"
            If T = 11 Then mySheet.Range("B" & N) = "ActiveX"
            If T = 100 Then mySheet.Range("B" & N) = "Book/Sheet Class Module"
            mySheet.Range("C" & N) = ActiveWorkbook.name
            With VBC.CodeModule
                i = .CountOfDeclarationLines + 1
                sTmp = ""
                Do Until i >= .CountOfLines
                    mySheet.Range("D" & N) = .ProcOfLine(i, vbext_pk_Proc)
                    i = i + .ProcCountLines(.ProcOfLine(i, vbext_pk_Proc), vbext_pk_Proc)
                    If i < .CountOfLines Then N = N + 1
                Loop
            End With
            N = N + 1
        Next
    Next wb
    mySheet.Columns.AutoFit
    currBook.Activate
    Application.ScreenUpdating = True
End Sub

---

You know what would be really cool? Is to show (on top of something like this) all subs/procedures in all installed add-ins also. Now THAT would be something useful. :yes

I tried using the macrooptions, but I could only use that to set the shortcut, not return it (that I could find at least). I had to end up exporting the module to a temp file and then deleting it
I also added if its a Sub/Function, etc, as well as private/public. basically anything before the proc name

I've got some other stuff to do for a little bit, then im going home, so I'm posting the non-userform version of it right now, and I'll post the userform version later on today.

This is turning into something that could be quite useful, so keep the suggestions coming!

Code:

---

Private Sub ModuleBreakdown()
 Dim N As Integer, i As Long, T As Integer, vFileNum As Integer
 Dim VBC As VBComponent, sTmp As String, sTmp2 As String, WB As Workbook
 Dim RegEx, RegO, RegS, modlTxt As String, sKey As String
 Set RegEx = CreateObject("vbscript.regexp")
 RegEx.Pattern = "Attribute [a-zA-Z][^ !@&#\.\$]*\.VB_ProcData\.VB_Invoke_func = \034.*\\n14"
 RegEx.Global = True
 Application.ScreenUpdating = False
 If ActiveWorkbook Is Nothing Then Workbooks.add Else Sheets.add After:=Sheets(Sheets.Count)
 Range("A1") = "COMPONENT NAME"
 Range("B1") = "COMPONENT TYPE"
 Range("C1") = "BOOK NAME"
 Range("D1") = "TYPE"
 Range("E1") = "PROCEDURES"
 Range("F1") = "KEYBOARD SHORTCUT"
 N = 2
 For Each VBC In ThisWorkbook.VBProject.VBComponents
  Range("A" & N) = VBC.Name
  T = VBC.Type
  If T = 1 Then Range("B" & N) = "Basic Module"
  If T = 2 Then Range("B" & N) = "Class Module"
  If T = 3 Then Range("B" & N) = "UserForm"
  If T = 11 Then Range("B" & N) = "ActiveX"
  If T = 100 Then Range("B" & N) = "Book/Sheet Class Module"
  Range("C" & N) = ThisWorkbook.Name
  With VBC.CodeModule
  If .CountOfLines > 0 Then
    VBC.Export "C:\asdftemp.txt"
    vFileNum = FreeFile()
    Open "C:\asdftemp.txt" For Binary Access Read As #vFileNum
    modlTxt = Input(LOF(vFileNum), #vFileNum)
    Close #vFileNum
    Kill "C:\asdftemp.txt"
    RegEx.Pattern = "Attribute [a-zA-Z][^ !@&#\.\$]*\.VB_ProcData\.VB_Invoke_Func = "".*\\n14"""
    Set RegO = RegEx.Execute(modlTxt)
    i = .CountOfDeclarationLines + 1
    Do Until i >= .CountOfLines
    sTmp = .ProcOfLine(i, vbext_pk_Proc)
    sTmp2 = .Lines(.ProcBodyLine(sTmp, vbext_pk_Proc), 1)
    Range("D" & N) = Left(sTmp2, InStr(1, sTmp2, sTmp, 1) - 1)
    Range("E" & N) = sTmp
    If RegO.Count > 0 Then
      For Each RegS In RegO
      If RegS Like "*" & sTmp & "*" Then Range("F" & N) = Mid(RegS, InStr(1, RegS, _
        "Func = """, 1) + 8, Len(RegS) - InStr(1, RegS, "Func = """, 1) - 12): Exit For
      Next
    End If
    i = i + .ProcCountLines(sTmp, vbext_pk_Proc)
    If i < .CountOfLines Then N = N + 1
    Loop
  End If
  End With
  N = N + 1
 Next
 Columns.AutoFit
 Application.ScreenUpdating = True
End Sub

---

Matt

Didnt see your post Zack, sorry about that
I just wasnt sure what John meant by

Quote:

---

The only thing left to sort is if I can access all the other workbooks (other than the one(s) that are open)

---

As I said though, I'll return to this later on today

Just an FYI, I have something that I was working on a while ago as well. I'll try and throw it up later (just for comparison) later tonight. (Too busy at work today)

It's a userform which, when completed, could be used to copy a routine from one workbook to another (without entering the VBE). It does search all add-ins, and returns a list of all procedures in there... at least for non-password protected ones. The code to copy the actual code isn't there, but the rest is.

Cheers,

Hi all,

Ivan F Moala has an Add-in that will list Short-Cut keys:
http://www.xcelfiles.com/GetShortCutKeys.html

As regards the main requirement, my second attempt:[vba]Public Const strWsName As String = "CodeSummary"

Code:

---

Sub Main()
    Dim wsSummary As Worksheet
On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(strWsName).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
Application.ScreenUpdating = False
    Set wsSummary = ThisWorkbook.Worksheets.Add
With wsSummary
        .Name = strWsName
        .Range("A1").Resize(1, 4) = _
            Array("Workbook Name", "Component Name", _
            "Component Type", "Procedure Name")
        Call OpenAndProcess
        .Columns("A:D").EntireColumn.AutoFit
    End With
    Sheet1.Select
    Application.ScreenUpdating = True
frmShowCode.Show
End Sub

Sub OpenAndProcess()
    Dim vaFileName As Variant
    Const MyDir As String = _
        "C:\Documents and Settings\Richie\My Documents\Excel\Tests"
    'change as required
With Application.FileSearch
        .NewSearch
        .LookIn = MyDir
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then
            Application.ScreenUpdating = False
            For Each vaFileName In .FoundFiles
                ListEm (vaFileName)
            Next
        Else
            MsgBox "There were no Excel files found."
        End If
        Application.ScreenUpdating = True
    End With
End Sub

Sub ListEm(ByVal Fname As String)
    Dim wbk As Workbook
    Dim wsSummary As Worksheet
    Dim VBComp As VBComponent, VBCodeMod As CodeModule
    Dim StartLine As Long, Msg As String, lRow As Long
Set wbk = Workbooks.Open(Filename:=Fname)
    Set wsSummary = ThisWorkbook.Worksheets(strWsName)
lRow = wsSummary.Cells(Rows.Count, 1).End(xlUp).Row
For Each VBComp In wbk.VBProject.VBComponents
        Set VBCodeMod = VBComp.CodeModule
        With VBCodeMod
            StartLine = .CountOfDeclarationLines + 1
            Do Until StartLine >= .CountOfLines
                Msg = .ProcOfLine(StartLine, vbext_pk_Proc)
                lRow = lRow + 1
                wsSummary.Cells(lRow, 1).Resize(1, 4) = _
                    Array(wbk.Name, VBComp.Name, CompTypeToName(VBComp), Msg)
                StartLine = StartLine + .ProcCountLines _
                    (.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
            Loop
        End With
    Next VBComp
wbk.Close savechanges:=True
End Sub

Function CompTypeToName(VBComp As VBComponent) As String
    Select Case VBComp.Type
        Case vbext_ct_ActiveXDesigner
            CompTypeToName = "ActiveX Designer"
        Case vbext_ct_ClassModule
            CompTypeToName = "Class Module      "
        Case vbext_ct_Document
            CompTypeToName = "Document          "
        Case vbext_ct_MSForm
            CompTypeToName = "MS Form              "
        Case vbext_ct_StdModule
            CompTypeToName = "Standard Module"
        Case Else
    End Select
End Function

---

And in the Userform:

Code:

---

Private Sub UserForm_Initialize()
    Dim MyList As Variant
MyList = ThisWorkbook.Worksheets(strWsName).UsedRange.Value
With Me.ListBox1
        .ColumnCount = 4
        .List = MyList
    End With
End Sub

---

HTH

Quote:

---

Originally Posted by mvidas

Didnt see your post Zack, sorry about that
I just wasnt sure what John meant by

Quote:

---

Originally Posted by johnske

The only thing left to sort is if I can access all the other workbooks (other than the one(s) that are open)

---

As I said though, I'll return to this later on today

---

Just woke up to find all this activity going on!!!

What I meant was - EVERY workbook on my C drive (as I already had a version {of the "For each W in WorkBooks type"} that gave everything that was in the books that were open - that's why I had a column for the name of the book - that was followed by another column with "MyList(N, 3) = ActiveWorkbook.Path") :bink:

OK, OK, I thought the original goal was stretching things a bit, and I didn't think this would be resolved so fast, so let's not be stingy here...Let's not limit this just to Excel procedures, there's no reason to exclude Word and all other procedures... :)

What would be really cool - and what I was ultimately looking at was this:

A procedure that listed every other procedure on my computer and that - when a given procedure was chosen/selected (in the list box) - the code pane of the selected procedure would be opened so that you could then read the code to see if what you were actually looking for was in the selected code pane. (after all, there are often cases where more than one procedure with the same name exists) ... :bink:

Quote:

---

Originally Posted by firefytr

You know what would be really cool? Is to show (on top of something like this) all subs/procedures in all installed add-ins also. Now THAT would be something useful. :yes

---

Hey Zack,

The following will return you the collection, and could be incorporated into anything here:

Code:

---

Dim wb As AddIn
For Each wb In Application.AddIns
Debug.Print wb.Name
Next wb

---

The kicker is though, when I used it with my file (attached), I got a list of all my addins, but most were password protected, so I couldn't access them.

On the rest of the thread...

Regarding the file attached, as mentioned before, I set this up with intentions of making it a code copier. Something easy for use in setting up a new workbook with pre loaded procs. It isn't completely finished (I never did get to writing the code to actually copy the procedures,) but it does collect all procedures in any given module, userform, etc. and ask you where you want to put them. (If you go all the way to finish, it will even tell you what was selected.

Checkboxes are on the userform to filter in/out certain classes of modules.

In order to bypass the addin protection issue, I set up a list of addins that I can access on a defaults page, in addition to some default settings for the checkbox.

At any rate... I'm hoping to finish it at some point, but maybe there's some code in here that someone finds useful.

(This is more to the procedure listing side, rather than getting things from all files as Johnske is looking for though.... could be a base, maybe, or just an idea farm...)

Cheers,

Thanx for that Ken,

Seems we're all on the same glide-path, but approaching the runway from different directions. ;)

The reason for opening the selected code-pane was not only to check if it's the one you're after, but - if it WAS the code (or if you were maybe only after a small bit of that procedure - a way of doing something) you could then copy, exit, and paste what you wanted wherever else you wanted it...

This is versus re-writing code all the time or manually searching through everything you've got (I have quite a few folders to search through - such as KB downloads {under various ppls names}, my own work, downloads from other sites, not to mention other folders for things that are already "operational" and being used all the time) - and no - I didn't expect to be able to open protected procedures and raid methods that ppl want to reserve for themselves - but protection would become obvious when you were asked for a password you didn't have, however a (Locked) column, or highlighting, may perhaps be helpful there...

Regards,
John :bink:

PS pls don't go too fast for me guys, you gotta remember I'm old and slow...:rofl

Just fyi, ASAP Utilities now has something similar to this as a built-in function/userform. It doesn't quite function the way this (thread) is going but if you have ASAP, you may want to check it out. It's pretty cool. The path is ...

ASAP Utilities -> System -> Macro/VBA Information (beta)

It's not completed yet, and (personally) I think it could have some more useful items, but the framework is there to give you an idea.

Old and slow: at least I'm not alone!
MD(the grey)

Thanx Zack!!

Just installed the ASAP utilities 308 setup and there's lotsa really cool stuff in there. But yeah, the macro list would be a great advantage when it's operational :bink:

Quote:

---

Originally Posted by mdmackillop

Old and slow: at least I'm not alone!
MD(the grey)

---

Yeah, trubbl is while I'm still tryin to nut out exactly wot someone's dun, someone else submits an improvement on the first, then someone else gives an improvement on the improvement, then someone gives a completely different way with further improvements.... :roll: ....way too fast for an old codger like me :rofl

Oh to be twenty years yunger again.... :bink:

Quote:

---

Originally Posted by Richie(UK)

Hi John,

Is this the sort of thing that you mean?

Code:

---

Sub Test()
    '1st part of code
    Function ListProcedures(wbk As Workbook, strModName As String) As String
    'add a reference to VBA Extensibility library <<<<<HERE !!!!
    Dim VBCodeMod As CodeModule
    'last part of code
End Function

---

A nice reference for this sort of thing is Chip Pearson's page here:
http://www.cpearson.com/excel/vbe.htm

HTH

---

Thanx for the link too Richie, I didn't have the help file VEENOB3 that was given there (on that site) so I had always wondered how you could programmatically add a reference (like yours above) for ppl that didn't know how to do it. I found it in that help file, haven't tried it yet, so I'm assuming you could put is as the 1st part of a procedure that requires the reference...Reference add/subtract code follows :bink: >>>

Code:

---

Private WithEvents X As ReferencesEvents
Sub Test()
    Set X = Application.VBE.Events.ReferencesEvents
End Sub

Private Sub X_ItemAdded(ByVal Reference As VBIDE.Reference)
    ' Put code to support item addition here
End Sub

Private Sub X_ItemRemoved(ByVal Reference As VBIDE.Reference)
    ' Put code to support item removal here
End Sub

---

Ok, this is a bit of everything, you can now use the listbox to open the VBE window and show the selected module, you can then copy code from the module, import or export modules, but you cant change the code in the module till you unload the userform.

The page to print the list on is deleted and a new one added (with a little formatting now) each time you choose this option.

I left out Matts option of showing whether it's a sub, private sub, function etc as I'll end up with too many columns for it to be practical (basically, for me it's more information than required). Similarly, I haven't included add-ins (you can do that yourself if you want it).

(But this still only looks at the active book) :bink:

Code:

---

'This lists all VB components in a 4 column list box

Private Sub UserForm_activate()
    Dim MyList(100, 4) As Variant
    Dim Count As Long, N, Typ As Integer
    Dim VBC As VBComponent, WB As Workbook
    With ListBox1
        .ControlTipText = "Click the module you want (you can " & _
        "look at or copy, but not change the code)"
    End With
    '//headings
    MyList(0, 0) = "COMPONENT NAME"
    MyList(0, 1) = "COMPONENT TYPE"
    MyList(0, 2) = "PROCEDURES"
    MyList(0, 3) = "BOOK NAME"
    '//define list
    N = 1
    For Each VBC In ActiveWorkbook.VBProject.VBcomponents
        MyList(N, 0) = VBC.Name
        Typ = VBC.Type
        If Typ = 1 Then MyList(N, 1) = "Bas Module"
        If Typ = 2 Then MyList(N, 1) = "Cls Module"
        If Typ = 3 Then MyList(N, 1) = "UserForm"
        If Typ = 11 Then MyList(N, 1) = "ActiveX"
        If Typ = 100 Then MyList(N, 1) = "Book/Sheet Cls Module"
        MyList(N, 3) = ActiveWorkbook.Name
        With VBC.CodeModule
            Count = .CountOfDeclarationLines + 1
            Do Until Count >= .CountOfLines
                MyList(N, 2) = .ProcOfLine(Count, vbext_pk_Proc)
                Count = Count + .ProcCountLines(.ProcOfLine(Count, vbext_pk_Proc), vbext_pk_Proc)
                If Count < .CountOfLines Then N = N + 1
            Loop
        End With
        N = N + 1
    Next
    '//load list to listbox
    ListBox1.List = MyList
End Sub

'This opens the VBE window and shows the selected module

Private Sub ListBox1_Click()
    On Error Resume Next '//must select a module
    ThisWorkbook.VBProject.VBcomponents(ListBox1.Value) _
    .CodeModule.CodePane.Show
End Sub
 

'This is optional - used if a 'hard copy' list of components is wanted

Private Sub CommandButton1_Click()
    Dim N As Integer, Count As Long, Typ As Integer
    Dim VBC As VBComponent, WB As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("VB Components").Delete
    Sheets.Add.Name = "VB Components"
    Cells.Select
    Selection.Font.Size = 8
    Rows("1:1").Select
    Selection.Font.Bold = True
    Application.DisplayAlerts = True
    Range("A1") = "COMPONENT NAME"
    Range("B1") = "COMPONENT TYPE"
    Range("C1") = "PROCEDURES"
    Range("D1") = "BOOK NAME"
    N = 2
    For Each VBC In ThisWorkbook.VBProject.VBcomponents
        Range("A" & N) = VBC.Name
        Typ = VBC.Type
        If Typ = 1 Then Range("B" & N) = "Bas Module"
        If Typ = 2 Then Range("B" & N) = "Cls Module"
        If Typ = 3 Then Range("B" & N) = "UserForm"
        If Typ = 11 Then Range("B" & N) = "ActiveX"
        If Typ = 100 Then Range("B" & N) = "Book/Sheet Cls Module"
        Range("D" & N) = ThisWorkbook.Name
        With VBC.CodeModule
            Count = .CountOfDeclarationLines + 1
            Do Until Count >= .CountOfLines
                Range("C" & N) = .ProcOfLine(Count, vbext_pk_Proc)
                Count = Count + .ProcCountLines(.ProcOfLine(Count, vbext_pk_Proc), vbext_pk_Proc)
                If Count < .CountOfLines Then N = N + 1
            Loop
        End With
        N = N + 1
    Next
    Columns.AutoFit
    Range("A1").Select
    Unload Me
End Sub

---

:bink: