■VBA VBComponents.Add(vbext_ct_MSForm)

#しつこいようだけど
[Visual Basic プロジェクトへのアクセスを信頼する]必要あり。

Sub try() '「WebBrowserを20コ配置したUserFormを作成」するコード
　　Const vbext_ct_MSForm As Long = 3
　　Const mgn As Single = 2　 '調整余白
　　Const w　 As Single = 100 'WebBrowser.Width|Height
　　Const h　 As Single = 20　'CommandButton.Height
　　Dim iw　　As Single
　　Dim ih　　As Single
　　Dim i　　 As Long

　　On Error GoTo extLine
　　With ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
　　　　iw = .Properties("Width") - .Properties("InsideWidth")
　　　　ih = .Properties("Height") - .Properties("InsideHeight")
　　　　.Properties("Width") = iw + mgn + w + mgn
　　　　.Properties("Height") = ih + mgn + w + mgn + h + mgn
　　　　With .Designer.Controls
　　　　　　For i = 1 To 20
　　　　　　　　With .Add("Shell.Explorer.2")
　　　　　　　　　　.Left = mgn
　　　　　　　　　　.Top = mgn
　　　　　　　　　　.Width = w
　　　　　　　　　　.Height = w
　　　　　　　　End With
　　　　　　Next
　　　　　　With .Add("Forms.CommandButton.1")
　　　　　　　　.Left = mgn
　　　　　　　　.Top = mgn + w + mgn
　　　　　　　　.Width = w
　　　　　　　　.Height = h
　　　　　　End With
　　　　End With
　　End With

extLine:
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　MsgBox .Number & "::" & .Description
　　　　End If
　　End With
End Sub

■UserForm作成コードで既出。
#一応、次回記事のネタフリで :D

■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

■VBA VBProject.VBComponents

#[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

■VBA TLI.TLIApplication

■組み込み定数の数値から文字列定数を取得の焼き直し。

昨日のリストを元にしてもよいですが、
『Office アプリケーションの組み込み定数の値を取得する方法』
http://support.microsoft.com/kb/239930/ja
タイプライブラリ情報から組み込み定数を列挙するサンプル。

まずは定数の各クラス名列挙

'#TLBINF32.DLLが在る環境のみ
Sub try1()
　　Dim aPath As String
　　
　　'Excel
　　aPath = "C:\Program Files\OFFICE11\EXCEL.EXE"
　　'Office
　　'aPath = "C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL"
　　Call sConstName(aPath)
End Sub
'---------------------------------------------------------------------
Sub sConstName(ByVal aPath As String)
　　Dim TLI As Object
　　Dim cnt As Long
　　Dim i　 As Long
　　Dim ret() As String
　　
　　On Error GoTo extLine
　　Set TLI = CreateObject("TLI.TLIApplication").TypeLibInfoFromFile(aPath)
　　With TLI.Constants
　　　　cnt = .Count
　　　　ReDim ret(1 To cnt, 0)
　　　　For i = 1 To cnt
　　　　　　ret(i, 0) = .Item(i).Name
　　　　　　'Debug.Print .Item(i).Name
　　　　Next
　　End With
　　'新規Book追加して列挙
　　With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1").Resize(cnt)
　　　　.Value = ret
　　　　.Columns.AutoFit
　　End With
　　
extLine:
　　Erase ret
　　Set TLI = Nothing
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　MsgBox .Number & "::" & .Description
　　　　End If
　　End With
End Sub

クラス名決め打ちで定数を列挙

'#TLBINF32.DLLが在る環境のみ
Sub try2()
　　Dim aPath As String
　　Dim x　　 As Long

　　With Application
　　　　x = Val(.Version)
　　　　If x > 9 Then
　　　　　　aPath = .Path & "\EXCEL.EXE"
　　　　Else
　　　　　　aPath = .Path & "\EXCEL" & CStr(x) & ".OLB"
　　　　End If
　　End With
　　Call sConstStr(aPath, "XlChartType")
End Sub
'---------------------------------------------------------------------
Sub sConstStr(ByVal aPath As String, ByVal cName As String)
　　Dim TLI As Object
　　Dim cnt As Long
　　Dim i　 As Long
　　Dim ret() As String

　　On Error GoTo extLine
　　Set TLI = CreateObject("TLI.TLIApplication").TypeLibInfoFromFile(aPath)
　　With TLI.Constants.NamedItem(cName).Members
　　　　cnt = .Count
　　　　ReDim ret(1 To cnt, 1 To 2)
　　　　For i = 1 To cnt
　　　　　　With .Item(i)
　　　　　　　　ret(i, 1) = .Value
　　　　　　　　ret(i, 2) = .Name
　　　　　　　　'Debug.Print .Value, .Name
　　　　　　End With
　　　　Next
　　End With
　　'新規Book追加して列挙
　　With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1").Resize(cnt, 2)
　　　　.Value = ret
　　　　.Columns.AutoFit
　　End With
　　
extLine:
　　Erase ret
　　Set TLI = Nothing
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　MsgBox .Number & "::" & .Description
　　　　End If
　　End With
End Sub

他、参考情報。
『[FILE] プログラムによる DLL クラスのメンバの取得』
http://support.microsoft.com/kb/172988/ja
『■ VBAで関数の参照を得るには？』
http://homepage1.nifty.com/MADIA/vb/vb_bbs2/200511/200511_05110142.html

■VBA VBProject.References

#ゃ、全部scrapじゃん、という意見もあるかもしれないですけれどもXD

'ActiveWorkbookの参照設定済みライブラリ列挙
Sub try()
　　Const x As Long = 4
　　Dim cnt As Long
　　Dim i　 As Long
　　Dim v
　　Dim ret() As String

　　On Error GoTo extLine
　　With ActiveWorkbook.VBProject.References
　　　　cnt = .Count
　　　　ReDim ret(0 To cnt, 1 To x)
　　　　For Each v In Array("Name", "Description", "FullPath", "GUID")
　　　　　　i = i + 1
　　　　　　ret(0, i) = v
　　　　Next
　　　　For i = 1 To cnt
　　　　　　With .Item(i)
　　　　　　　　ret(i, 1) = .Name
　　　　　　　　ret(i, 2) = .Description
　　　　　　　　ret(i, 3) = .FullPath
　　　　　　　　ret(i, 4) = .GUID
　　　　　　　　'Debug.Print ret(i, 1), ret(i, 2), ret(i, 3), ret(i, 4)
　　　　　　End With
　　　　Next
　　End With
　　'新規Book追加して列挙
　　With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1").Resize(cnt + 1, x)
　　　　.Value = ret
　　　　.Columns.AutoFit
　　End With

extLine:
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　MsgBox .Number & "::" & .Description
　　　　End If
　　End With
End Sub

※Excelメニュー[Alt][t][m][s]で

#2002/2003
[信頼できる発行元]..[□ VisualBasicプロジェクトへのアクセスを信頼する]
#Excel2007/2010
[開発者向けのマクロ設定]..[□ VBAプロジェクトオブジェクトモデルへのアクセスを信頼する]

チェックが必要。