■VBA VB_ProcData.VB_Invoke_Func

#[Visual Basic プロジェクトへのアクセスを信頼する]シリーズ :)

'ActiveWorkbookのマクロショートカットキーを列挙。
Sub try()
　　Const vbext_ct_StdModule = 1 '標準Module
　　Dim vbc As Object　　　　　　'VBIDE.VBComponent
　　Dim tmp As String
　　Dim cnt As Long
　　Dim n　 As Long
　　Dim i　 As Long
　　Dim buf() As String
　　Dim ret(0 To 100, 1 To 2) As String

　　On Error GoTo extLine
　　ret(0, 1) = "Module"
　　ret(0, 2) = "VB_Invoke_Func"
　　tmp = Application.DefaultFilePath & "\" & CLng(Date) & "temp.tmp"
　　With ActiveWorkbook
　　　　For Each vbc In .VBProject.VBComponents
　　　　　　With vbc
　　　　　　　　If .Type = vbext_ct_StdModule Then
　　　　　　　　　　.Export tmp
　　　　　　　　　　n = FreeFile
　　　　　　　　　　Open tmp For Input As #n
　　　　　　　　　　buf = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
　　　　　　　　　　Close #n
　　　　　　　　　　Kill tmp
　　　　　　　　　　For i = 0 To UBound(buf)
　　　　　　　　　　　　If buf(i) Like "Attribute*.VB_Invoke_Func*" Then
　　　　　　　　　　　　　　cnt = cnt + 1
　　　　　　　　　　　　　　ret(cnt, 1) = .Name
　　　　　　　　　　　　　　ret(cnt, 2) = buf(i)
　　　　　　　　　　　　End If
　　　　　　　　　　Next
　　　　　　　　End If
　　　　　　End With
　　　　Next
　　End With
　　If cnt > 0 Then
　　　　'新規Bookに列挙
　　　　With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1").Resize(cnt + 1, 2)
　　　　　　.Value = ret
　　　　　　.Columns.AutoFit
　　　　End With
　　Else
　　　　MsgBox "no data"
　　End If
　　
extLine:
　　Set vbc = Nothing
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　MsgBox .Number & "::" & .Description
　　　　End If
　　End With
End Sub