-1

我想使用这段代码

Sub PieMarkers()

Dim chtMarker As Chart
Dim chtMain As Chart
Dim intPoint As Integer
Dim rngRow As Range
Dim lngPointIndex As Long
Dim x 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
    SetColorScheme chtMarker, x
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
    x=x+1
    Debug.Print rngColors.address()
Next

lngPointIndex = 0

Application.ScreenUpdating = True
End Sub


 Sub SetColorScheme(cht As Chart, i As Long)

    Dim y_off As Long, rngColors As Range
    Dim x As Long

    y_off = i Mod 13

    'this is the range of cells which has the colors you want to apply
    Set rngColors = ThisWorkbook.Sheets("Basic").Range(ThisWorkbook.Sheets("Basic").Range("A19").Value).Offset(y_off, 0)

    With cht.SeriesCollection(1)
        'loop though the points and apply the corresponding fill color from the cell
        For x = 1 To .Points.Count
            .Points(x).Format.Fill.ForeColor.RGB = _
                             rngColors.Cells(x).Interior.Color
        Next x
    End With

End Sub

根据工作簿中指定的颜色（用作工作表中单元格背景颜色的颜色）为多个饼图着色，所有饼图都具有相同数量的切片（每个 3 个，8 个饼图）。这是子配色方案.

代码编译没有错误，问题只是它只使用范围内的第一个到指定的颜色（比如 A10:Z10，只有 A10 和 B10 中的颜色为 8 个饼图的所有部分着色（总共 24 个切片） A10 和 B10 的两种颜色）。有人能告诉我我需要改变什么，以便为不同的切片使用从 A10 到 X10 的整个颜色范围（24 种不同颜色）吗？

4

1 回答 1

0

似乎For loop that use cht.SeriesCollection(1).Points.Count作为边界不会超过两次迭代。

您应该使用特定于要从中检索颜色的单元格范围的内部循环，如果颜色较少，则使用 if 条件语句。

于 2013-07-07T21:22:36.960 回答