0

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

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

    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但代码显然不适用于询问的人。任何人都可以就如何重写代码的功能部分给我任何建议

我的粗略方法是：

  1. 选择工作表，然后在复制后抓取每个图表
  2. 使用唯一的 RGB 代码更改每个段的颜色

但是我不清楚如何将它实现到 VBA 中。我非常感谢您对这个问题的任何评论。

4

1 回答 1

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
于 2013-06-29T23:56:24.417 回答