PDA

View Full Version : Solved: Listing Names of Subs & Functions



johnske
10-29-2004, 03:41 AM
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
'***************************************************

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
'***************************************************

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

Richie(UK)
10-29-2004, 06:35 AM
Hi John,

Is this the sort of thing that you mean?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

johnske
10-29-2004, 07:04 AM
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:

mvidas
10-29-2004, 07:27 AM
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!)

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

johnske
10-29-2004, 07:40 AM
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"}

mvidas
10-29-2004, 08:58 AM
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
'************************************************* **
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
'************************************************* **
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

mdmackillop
10-29-2004, 09:00 AM
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

mvidas
10-29-2004, 09:01 AM
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

Zack Barresse
10-29-2004, 09:09 AM
Matt, that's a slick rendition. :yes I'll find that very useful. :D

Nice job fellas!

mvidas
10-29-2004, 09:50 AM
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

Ken Puls
10-29-2004, 10:27 AM
Hi there,

mvidas, don't know if this will help, but just recorded this:
Application.MacroOptions Macro:="PERSONAL.XLS!Macro1", Description:="", _
ShortcutKey:="B"

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

Cheers,

Zack Barresse
10-29-2004, 11:22 AM
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 ...

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

mvidas
10-29-2004, 11:30 AM
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!

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 (!@&#.$]*.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 (!@&#.$]*.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

mvidas
10-29-2004, 11:32 AM
Didnt see your post Zack, sorry about that
I just wasnt sure what John meant by

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

Ken Puls
10-29-2004, 12:25 PM
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,

Richie(UK)
10-29-2004, 01:04 PM
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:Public Const strWsName As String = "CodeSummary"

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 FunctionAnd in the Userform:Private Sub UserForm_Initialize()
Dim MyList As Variant

MyList = ThisWorkbook.Worksheets(strWsName).UsedRange.Value

With Me.ListBox1
.ColumnCount = 4
.List = MyList
End With

End SubHTH

johnske
10-29-2004, 01:10 PM
Didnt see your post Zack, sorry about that
I just wasnt sure what John meant by
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 todayJust 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:

johnske
10-29-2004, 02:01 PM
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:

Ken Puls
10-29-2004, 02:46 PM
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. :yesHey Zack,

The following will return you the collection, and could be incorporated into anything here:
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,

johnske
10-29-2004, 03:31 PM
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

Zack Barresse
10-29-2004, 03:37 PM
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.

mdmackillop
10-29-2004, 03:53 PM
Old and slow: at least I'm not alone!
MD(the grey)

johnske
10-29-2004, 04:10 PM
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:

johnske
10-29-2004, 04:20 PM
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:

johnske
10-29-2004, 05:14 PM
Hi John,

Is this the sort of thing that you mean?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

HTHThanx 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: >>>
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

johnske
10-30-2004, 12:56 AM
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:

'************************************************* **
'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: