-1

我有以下代码

    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

该代码尝试创建一个以饼图作为气泡的气泡图。在这个版本中，颜色主题用于在每个饼图（气泡）中创建不同的颜色。但是，如果没有颜色主题，有任何方法可以做到这一点。我一直使用 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 个饼图，每个饼图有 3 个不同的段。每个段（总共 24 个）应该有不同的颜色，可以通过 RGB 值指示，如第一个答案

4

1 回答 1

1

据我了解，您需要 3x8 = 24 种颜色。我在这里仅举几个例子（例如113567，、1039834等）来向您展示我的意思。

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

您将需要：

  • 在块内添加适当数量的If/Then语句。With
  • 确定用于这些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

然后修改你的For Each 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 个点中的每一个分配不同的颜色。

于 2013-06-30T14:08:42.683 回答