■組み込み定数の数値から文字列定数を取得の焼き直し。
昨日のリストを元にしてもよいですが、
『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
昨日のリストを元にしてもよいですが、
『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