#[Visual Basic プロジェクトへのアクセスを信頼する]必要があります。
'ActiveWorkbookのプロシージャリスト列挙
'TEST中、何度かExcelが落ちたのでステップ実行は危険。
Sub GetProcLst()
Const vbext_ct_StdModule = 1 '標準Module
Const vbext_ct_ClassModule = 2 'ClassModule
Const vbext_ct_MSForm = 3 'FormClassModule
Const vbext_ct_Document = 100 'Book|SheetModule
Const vbext_pk_Proc = 0 'Sub|Function プロシージャ
Dim vbc As Object 'VBIDE.VBComponent
Dim tmp As String
Dim cnt As Long
Dim mx As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim v
Dim ret(0 To 1000, 1 To 5) As String
On Error GoTo extLine
For Each v In Array("Book", "Module", "Type", "Procedure", "Arg")
i = i + 1
ret(0, i) = v
Next
cnt = 1
With ActiveWorkbook
For Each vbc In .VBProject.VBComponents
'Select Case vbc.Type
'Case vbext_ct_StdModule, vbext_ct_Document
ret(cnt, 1) = .Name
ret(cnt, 2) = vbc.Name
ret(cnt, 3) = vbc.Type
With vbc.CodeModule
mx = .CountOfLines
i = 1
Do Until i > mx
tmp = .ProcOfLine(i, vbext_pk_Proc)
If tmp = "" Then
i = i + 1
Else
j = .ProcBodyLine(tmp, vbext_pk_Proc)
ret(cnt, 4) = tmp
ret(cnt, 5) = .Lines(j, 1)
k = j
Do Until Right$(ret(cnt, 5), 2) <> " _"
k = k + 1
ret(cnt, 5) = ret(cnt, 5) & vbLf & .Lines(k, 1)
Loop
i = j + .ProcCountLines(tmp, vbext_pk_Proc)
cnt = cnt + 1
End If
Loop
End With
'End Select
Next
End With
'新規Bookに列挙
With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1").Resize(cnt, 5)
.Value = ret
.Columns.AutoFit
.Rows.AutoFit
End With
extLine:
Set vbc = Nothing
With Err()
If .Number <> 0 Then
MsgBox .Number & "::" & .Description
End If
End With
End Sub
他、参考情報。
『[XL97] モジュール、プロシージャの情報取得および操作方法』
http://support.microsoft.com/kb/410621/ja
『Visual Basic 6.0 を使用して Excel ブックに格納されているマクロの名前を取得する方法』
http://support.microsoft.com/kb/315731/ja
『Excel 2003 および Excel 2007 で Visual Basic プロジェクトへのアクセスをプログラミングにより許可すると実行時エラーが表示される場合がある』
http://support.microsoft.com/kb/813969/ja
'ActiveWorkbookのプロシージャリスト列挙
'TEST中、何度かExcelが落ちたのでステップ実行は危険。
Sub GetProcLst()
Const vbext_ct_StdModule = 1 '標準Module
Const vbext_ct_ClassModule = 2 'ClassModule
Const vbext_ct_MSForm = 3 'FormClassModule
Const vbext_ct_Document = 100 'Book|SheetModule
Const vbext_pk_Proc = 0 'Sub|Function プロシージャ
Dim vbc As Object 'VBIDE.VBComponent
Dim tmp As String
Dim cnt As Long
Dim mx As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim v
Dim ret(0 To 1000, 1 To 5) As String
On Error GoTo extLine
For Each v In Array("Book", "Module", "Type", "Procedure", "Arg")
i = i + 1
ret(0, i) = v
Next
cnt = 1
With ActiveWorkbook
For Each vbc In .VBProject.VBComponents
'Select Case vbc.Type
'Case vbext_ct_StdModule, vbext_ct_Document
ret(cnt, 1) = .Name
ret(cnt, 2) = vbc.Name
ret(cnt, 3) = vbc.Type
With vbc.CodeModule
mx = .CountOfLines
i = 1
Do Until i > mx
tmp = .ProcOfLine(i, vbext_pk_Proc)
If tmp = "" Then
i = i + 1
Else
j = .ProcBodyLine(tmp, vbext_pk_Proc)
ret(cnt, 4) = tmp
ret(cnt, 5) = .Lines(j, 1)
k = j
Do Until Right$(ret(cnt, 5), 2) <> " _"
k = k + 1
ret(cnt, 5) = ret(cnt, 5) & vbLf & .Lines(k, 1)
Loop
i = j + .ProcCountLines(tmp, vbext_pk_Proc)
cnt = cnt + 1
End If
Loop
End With
'End Select
Next
End With
'新規Bookに列挙
With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1").Resize(cnt, 5)
.Value = ret
.Columns.AutoFit
.Rows.AutoFit
End With
extLine:
Set vbc = Nothing
With Err()
If .Number <> 0 Then
MsgBox .Number & "::" & .Description
End If
End With
End Sub
他、参考情報。
『[XL97] モジュール、プロシージャの情報取得および操作方法』
http://support.microsoft.com/kb/410621/ja
『Visual Basic 6.0 を使用して Excel ブックに格納されているマクロの名前を取得する方法』
http://support.microsoft.com/kb/315731/ja
『Excel 2003 および Excel 2007 で Visual Basic プロジェクトへのアクセスをプログラミングにより許可すると実行時エラーが表示される場合がある』
http://support.microsoft.com/kb/813969/ja