最初我写了一个函数,它根据预定义的颜色主题改变了一系列饼图的外观
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
但是,路径不是常量,我想用rgb颜色自己定义每个饼图切片。 我在prevoveru主题(How to use VBA to colour pie chart)中的stackoverflow上找到了一种更改饼图每个切片颜色的方法
但我不知道如何将代码实现到上面提到的函数中。我可以写下
吗? Function GetColorScheme(i As Long) As String
Select Case i Mod 2
Case 0
Dim clr As Long, x As Long
For x = 1 To 3
clr = RGB(0, x * 8, 0)
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(x)
.Format.Fill.ForeColor.RGB = clr
End With
Next x
Case 1
Dim clr As Long, x As Long
For x = 1 To 3
clr = RGB(0, x * 8, 0)
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(x)
.Format.Fill.ForeColor.RGB = clr
End With
Next x
End Select
End Function
该函数链接到脚本的主要部分(即)
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
行
ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)
获取函数的值(参见代码的第一位 - 原始函数)但现在我不再定义thmColor变量,并且不知道如何最好地将代码实现到函数部分
答案 0 :(得分:2)
这样的东西(你需要调整颜色以满足你的需要)
http://www.rapidtables.com/web/color/RGB_Color.htm
Sub ApplyColorScheme(cht As Chart, i As Long)
Dim arrColors
Select Case i Mod 2
Case 0
arrColors = Array(RGB(50, 50, 50), _
RGB(100, 100, 100), _
RGB(200, 200, 200))
Case 1
arrColors = Array(RGB(150, 50, 50), _
RGB(150, 100, 100), _
RGB(250, 200, 200))
End Select
With cht.SeriesCollection(1)
.Points(1).Format.Fill.ForeColor.RGB = arrColors(0)
.Points(2).Format.Fill.ForeColor.RGB = arrColors(1)
.Points(3).Format.Fill.ForeColor.RGB = arrColors(2)
End With
End Sub
使用示例:
chtMarker.SeriesCollection(1).Values = rngRow
ApplyColorScheme chtMarker, thmColor
chtMarker.Parent.CopyPicture xlScreen, xlPicture