■組み込み定数の数値から文字列定数を取得

月刊「半角チルダ」１月号です。（うそ XD

Q&A掲示板に出入りしてると、自分ではあまりニーズを感じない要件に触れる事ができて、それが意外と勉強になる事が多いんですよね。
Office 2003 excel vbaでグラフの種類を一系列毎に判定 - 教えて！goo
ここで TypeLibInformation ActiveX オブジェクト (tlbinf32.dll) について知る事ができました。
せっかくなので、ちょっとお試し。

Option Explicit

Sub pre()
　　'サンプルデータシート追加し、３系列チャートを作成
　　Dim ws As Worksheet
　　Dim r　As Range
　　Dim s　As String
　　Dim i　As Long
　　Dim v

　　v = VBA.Array(, xlColumnClustered, xlLine, xlLineMarkers)
　　With Sheets.Add
　　　　Set r = .Range("A1:C10")
　　　　r.Formula = "=int(rand()*100)"
　　　　With .ChartObjects.Add(.Range("D1").Left, 0, 250, 200).Chart
　　　　　　.HasLegend = False
　　　　　　.ChartType = xlColumnClustered
　　　　　　For i = 1 To 3
　　　　　　　　With .SeriesCollection.NewSeries
　　　　　　　　　　.Values = r.Columns(i)
　　　　　　　　　　.ChartType = v(i)
　　　　　　　　End With
　　　　　　Next
　　　　End With
　　End With
　　Set r = Nothing
End Sub

まずはサンプルチャートを作成。



ActiveSheet.ChartObjects(1).Chart の各系列の ChartType を文字列定数で取得するサンプルです。

Sub test()
　　Dim TLI As Object
　　Dim cnt As Long
　　Dim i　 As Long
　　Dim v() As String

　　If fGetTLIap(TLI) Then
　　　　With ActiveSheet.ChartObjects(1).Chart.SeriesCollection
　　　　　　cnt = .Count
　　　　　　ReDim v(1 To cnt)
　　　　　　For i = 1 To cnt
　　　　　　　　v(i) = i & " : " & fConstStr(TLI, "xlcharttype", .Item(i).ChartType)
　　　　　　　　'Debug.Print v(i)
　　　　　　Next
　　　　End With
　　　　MsgBox Join(v, vbLf)
　　End If

　　Set TLI = Nothing
End Sub
'---------------------------------------------------------------------
Function fGetTLIap(ByRef TLI As Object) As Boolean
　　Dim aPath As String
　　Dim x　　 As Long

　　On Error Resume Next
　　With Application
　　　　x = Val(.Version)
　　　　If x > 9 Then
　　　　　　aPath = .Path & "¥EXCEL.EXE"
　　　　Else
　　　　　　aPath = .Path & "¥EXCEL" & CStr(x) & ".OLB"
　　　　End If
　　End With
　　Set TLI = CreateObject("TLI.TLIApplication").TypeLibInfoFromFile(aPath)
　　fGetTLIap = Not (TLI Is Nothing)
End Function
'---------------------------------------------------------------------
Function fConstStr(ByRef TLI As Object, _
　　　　　　　　　 ByVal cName As String, _
　　　　　　　　　 ByVal cValue As Long) As String

　　Dim MI　As Object 'MemberInfo
　　Dim ret As String

　　On Error GoTo extLine
　　For Each MI In TLI.Constants.NamedItem(cName).Members
　　　　If MI.Value = cValue Then
　　　　　　ret = MI.Name
　　　　　　Set MI = Nothing
　　　　　　Exit For
　　　　End If
　　Next

extLine:
　　With Err()
　　　　If .Number <> 0 Then
　　　　　　ret = .Number & vbLf & .Description
　　　　End If
　　End With
　　fConstStr = ret
End Function

結果。
1 : xlColumnClustered
2 : xlLine
3 : xlLineMarkers