Question

我有以下代码，其中代码尝试使用饼图作为气泡创建气泡图。在此版本中，颜色主题用于在函数部分的每个饼图（气泡）中创建不同的颜色，我遇到的问题是它的工作原理取决于调色板的路径。

是否有一种简单的方法可以使函数以独立于这些路径的方式工作，方法是为每个饼图段编码颜色或使用标准化路径（可能不可能，不可取）。

    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

代码在气泡上反复复制单个图表。所以我想将函数（现在称为Get colourscheme）更改为一个函数，为每个饼图的每个片段分配一个唯一的RGB颜色。这里讨论了一个类似的问题Change the Point Color in chart excel VBA，但代码显然不适用于提出要求的人。任何人都可以就如何重写代码的函数部分给出任何建议

我的粗略方法是：

选择工作表，然后在复制后抓取每个图表
使用唯一的RGB代码

但是我如何将它实现到VBA中并不清楚。我真的很感激这个问题的任何评论。

Answer 1

以下是如何在饼图中设置每个切片的颜色。不确定如何确定哪个切片获得什么颜色。

Dim clr As Long, x As Long

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

Answer 2

对我使用的原始答案进行合理的概括：

Sub colorPie()
    Set chrt = ActiveChart
    'or: Set chrt = ActiveSheet.ChartObjects(j).Chart
    'or: Set chrt = Application.Workbooks("xyz.xlsm").Worksheets(k).ChartObjects(j).Chart
    i = 0
    N = chrt.SeriesCollection(1).Points.Count
    For Each pnt In chrt.SeriesCollection(1).Points
        pnt.Format.Fill.ForeColor.RGB = calculate_RGB_value(i,N)
        i = i + 1
    Next pnt
End Sub

如何使用VBA为饼图着色

2 个答案: