-1

次のコードがあります

    Sub PieMarkers()

Dim chtMarker As Chart
Dim chtMain As Chart
Dim intPoint As Integer
Dim rngRow As Range
Dim lngPointIndex As Long
Dim thmColor As Long
Dim myTheme As String


Application.ScreenUpdating = False
Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart

Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart
Set rngRow = Range(ThisWorkbook.Names("PieChartValues").RefersTo)

For Each rngRow In Range("PieChartValues").Rows
    chtMarker.SeriesCollection(1).Values = rngRow
    ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
    thmColor = thmColor + 1
Next

lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

Function GetColorScheme(i As Long) As String
Const thmColor1 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Blue Green.xml"
Const thmColor2 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Orange Red.xml"
    Select Case i Mod 2
        Case 0
            GetColorScheme = thmColor1
        Case 1
            GetColorScheme = thmColor2
    End Select
End Function

このコードは、円グラフをバブルとして使用してバブル チャートを作成しようとします。このバージョンのように、カラー テーマを使用して、各円グラフ (円グラフ) で異なる色を作成します。ただし、カラーテーマなしでこれを行う方法はあります。これを行うために Collection オブジェクトを使用しましたが、これをコードに実装する方法がわかりません。上記のコードの関数部分を変更する必要があると思いますか?

更新されたコード

    Sub PieMarkers()

Dim srs As Series
Dim pt As Point
Dim p As Long
Dim c As Long
Dim col As Long
Dim chtMarker As Chart
Dim chtMain As Chart
Dim intPoint As Integer
Dim rngRow As Range
Dim lngPointIndex As Long
Dim thmColor As Long
Dim myTheme As String


Application.ScreenUpdating = False
Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart

Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart
Set rngRow = Range(ThisWorkbook.Names("PieChartValues").RefersTo)

Set srs = chtMarker.SeriesCollection(1)
For Each rngRow In Range("PieChartValues").Rows
    c = c + 1
    srs.Values = rngRow
    For p = 1 To srs.Points.Count
        Set pt = srs.Points(p)
        With pt.Format.Fill.ForeColor
            col = p + (srs.Points.Count * c)
            If col = 1 Then .RGB = 113567
            If col = 2 Then .RGB = 116761
            If col = 3 Then .RGB = 239403
            If col = 4 Then .RGB = 398394
            'etc.
            'etc.
            '## Add more IF statements to assign more colors.
            If col = 24 Then .RGB = 1039834
        End With
    Next
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
Next
lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

そのため、エラーなしでコードの下位ビットをコンパイルできます。問題は、チャートがその後2色でしか色付けされないことです(コードで指定されている5色ではありません)。8 つの円グラフがあり、それぞれに 3 つの異なるセグメントがあります。各セグメント (合計 24) は、最初の回答のように RGB 値で示される異なる色を持つ必要があります。

4

1 に答える 1

1

私が理解しているように、必要な色は 3x8 = 24 色です。私が何を意味するかを示すために、いくつかの例 (例: 、 など) をここ113567に示します。1039834

これを行うにはもっと洗練された方法がありますが、現時点では、それらはあなたのスキルセットを超えていると思います。

次のことを行う必要があります。

  • ブロックIf/Then内に適切な数のステートメントを追加します。With
  • If/Thenこれらのステートメント内の色に使用するいくつかの RGB/Long 値を特定します。24個必要だと思います。

コードを整理するために、さらにいくつかの変数を宣言します。

Dim srs as Series
Dim pt as Point
Dim p as Long '# Point Counter
Dim c as Long '# Chart Counter
Dim col as Long '# p*c

次にFor Each rngRow...、次のようにループを変更します。

Set srs = chtMarker.SeriesCollection(1)
For Each rngRow In Range("PieChartValues").Rows
    c = c+1
    srs.Values = rngRow
    '## The loop below will be used to do colors on individual points:
    For p = 1 to srs.Points.Count
        Set pt = srs.Points(p)
        With pt.Format.Fill.ForeColor
            col = p+(srs.Points.Count * c)
            If col = 1 then .RGB = 113567
            If col = 2 Then .RGB = 209345
            If col = 3 Then .RGB = 239403
            If col = 4 Then .RGB = 398394
            'etc.
            'etc.
            '## Add more IF statements to assign more colors.
            If col = 24 Then .RGB = 1039834
        End With
    Next
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
Next

col1 から 24 までの値になる新しい変数があり、各チャートの各ポイントに設定されます。ブロック内で、With各ポイントに色を割り当てます。

最初のグラフでは、これはcolの値を使用{1,2,3}する必要があり、2 番目のグラフでは の値を使用{4,5,6}し、3 番目のグラフでは {7,8,9}などの値を使用する必要があります。

したがって、1 つのポイントに 1 つの色のみを適用しますが、8 つのチャートのそれぞれで 3 つのポイントのそれぞれに異なる色を割り当てます。

于 2013-06-30T14:08:42.683 に答える