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 = \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