Vba 如何迭代序列中的点并对其应用不同的颜色？

我有以下代码

    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

代码尝试创建一个以饼图为气泡的气泡图。在这个版本中，颜色主题用于在每个饼图（Bulble）中创建不同的颜色。然而，没有颜色主题，没有任何方法可以做到这一点。我已经被指派到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

---

因此，我可以编译代码的低位，而不会出现错误。问题是，图表之后只涂上两种颜色（而不是代码中指定的5种颜色）。共有8个饼图，每个饼图有三个不同的部分。每个区段（总共24个）应具有不同的颜色，可通过RGB值指示，如第一个答案所示

据我所知，您需要3x8=24种颜色。我在这里只举了几个例子（例如，

113567

，

1039834

，等等）来说明我的意思

有更复杂的方法可以做到这一点，但在这一点上，我认为它们超出了你的技能范围，所以我们将要进行暴力，明确的操作

您需要：

• 在

  With

  块中添加适当数量的

  If/Then

  语句
• 确定这些

  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

然后为每个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

我们有一个新变量
col
，它的值介于1和24之间，将为每个图表中的每个点设置。在
With
块中，我们为每个点指定一种颜色

在第一个图表中，应该使用
col
值
{1,2,3}
，在第二个图表中应该使用
{4,5,6}
值，在第三个图表中，{
7,8,9}
等

因此，它只对一个点应用一种颜色，但在8张图表中的每一张图表中，它为3个点的每个点指定不同的颜色。
@TimonHeinomann correct。该函数用于动态加载多个颜色方案之一。在这段代码中，我们不需要这样做，只需为每个图表中的每个点指定颜色。我做了一个修订，我认为它可以确保颜色不会被多次使用，只要你放24个不同的
If/Then
语句。不，这不是它的工作原理。但是因为我没有测试过，我需要再做一次修改。是的，应该是正确的。我假设3张图表，8分。但是如果它是8个图表，每个图表3个点，那么这段代码也应该在这方面起作用。而且，如果这最终不起作用，那么你必须自己去解决它。我不会再回答这个问题了。如果你发布你正在使用的代码，我可能会帮你。否则，我无法读懂你的心思。可能是