2

最初に、定義済みのカラー テーマに従って一連の円グラフの外観を変更する関数を作成しました。

    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

ただし、パスは一定ではないため、円グラフの各スライスを RGB カラーで独自に定義したいと考えています。ここで、前のトピック ( VBA を使用して円グラフに色を付ける方法) の stackoverflow で、円グラフの各スライスの色を変更する方法を見つけました。

しかし、上記の関数にコードを実装する方法がわかりません。私は潜在的に書くことができますか

    Function GetColorScheme(i As Long) As String

    Select Case i Mod 2
        Case 0
            Dim clr As Long, x As Long

For x = 1 To 3
    clr = RGB(0, x * 8, 0)
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(x)
        .Format.Fill.ForeColor.RGB = clr
    End With
Next x
        Case 1
            Dim clr As Long, x As Long

For x = 1 To 3
    clr = RGB(0, x * 8, 0)
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(x)
        .Format.Fill.ForeColor.RGB = clr
    End With
Next x
    End Select
End Function

関数はスクリプトの主要部分にリンクされています（つまり）

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

どこの行

 ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)

関数の値を取得します (コードの最初のビット - 元の関数を参照) が、今では thmColor 変数が定義されておらず、コードを関数部分に最適に実装する方法がわかりません

4

1 に答える 1

5

このようなもの（ニーズに合わせて色を調整する必要があります）

http://www.rapidtables.com/web/color/RGB_Color.htm

Sub ApplyColorScheme(cht As Chart, i As Long)

    Dim arrColors

    Select Case i Mod 2
        Case 0
            arrColors = Array(RGB(50, 50, 50), _
                              RGB(100, 100, 100), _
                              RGB(200, 200, 200))
        Case 1
            arrColors = Array(RGB(150, 50, 50), _
                              RGB(150, 100, 100), _
                              RGB(250, 200, 200))
    End Select

    With cht.SeriesCollection(1)
        .Points(1).Format.Fill.ForeColor.RGB = arrColors(0)
        .Points(2).Format.Fill.ForeColor.RGB = arrColors(1)
        .Points(3).Format.Fill.ForeColor.RGB = arrColors(2)
    End With

End Sub

使用例:

chtMarker.SeriesCollection(1).Values = rngRow
ApplyColorScheme chtMarker, thmColor
chtMarker.Parent.CopyPicture xlScreen, xlPicture
于 2013-06-30T17:00:57.550 に答える