'円グラフのデータ要素のパターンを設定するマクロ(Excel95)

'グラフを選択してMyChartColorマクロを実行してください。

'パターン定義表の作成が必要です。
'例えばA列にXの値、B列にパターンを設定し、A2:B4にChartColorという
'名前を定義してください。

'      A          B
' 1  Xの値   設定パターン
' 2  東京
' 3  名古屋
' 4  大阪

Option Explicit

Const ChartColorRangeName = "ChartColor"

Sub MyChartColor()
    Const myTitle As String = "データ要素のパターン設定"
    Dim series1 As Object, interior1 As Object
    Dim range1 As Range, r As Range
    Dim vXValues As Variant, v As Variant
    Dim i As Long

    On Error Resume Next
    Set series1 = ActiveChart.SeriesCollection(1)
    On Error GoTo 0
    If series1 Is Nothing Then
        MsgBox "グラフを選択して実行してください。", vbExclamation, myTitle
        Exit Sub
    End If

    On Error Resume Next
    Set range1 = Application.Evaluate(ChartColorRangeName)
    On Error GoTo 0
    If range1 Is Nothing Then
        MsgBox "Xの値とパターンを定義したn行2列の範囲に" & Chr$(10) & _
            """" & ChartColorRangeName & """という名前を定義してください。", _
            vbExclamation, myTitle
        Exit Sub
    End If

    If MsgBox("データ項目のパターンを Xの値に応じて設定します。", _
        vbOKCancel Or vbExclamation, myTitle) <> vbOK Then Exit Sub

    Application.ScreenUpdating = False

    vXValues = series1.XValues
    i = 1
    For Each v In vXValues
        For Each r In range1.Cells
            If v = r.Value Then
                Set interior1 = r.Offset(0, 1).Interior
                With series1.Points(i).Interior
                    .ColorIndex = interior1.ColorIndex
                    .Pattern = interior1.Pattern
                    If .Pattern <> xlNone Then
                        If interior1.PatternColorIndex = xlAutomatic Then
                            .PatternColorIndex = 1
                        Else
                            .PatternColorIndex = interior1.PatternColorIndex
                        End If
                    End If
                End With
                Exit For
            End If
        Next
        i = i + 1
    Next
    Application.ScreenUpdating = True
End Sub