Initially I wrote a function which changes the appearance of a series of pie-charts according to predefined colour themes
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
However, the paths are not constant and I would like to define each Pie chart slice on its own by an rgb colour.
I found here on stackoverflow in a previosu topic (How to use VBA to colour pie chart) a way to change the colour of each slice of a pie chart
but I don’t knwo how to implement the code into the function mentioned above. Could I potentially write
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
The function is linked to the main part of the script (which is)
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
where the line
ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)
gets the value of the function (see first bit of code – the original function) but now I don#t longer have the thmColor variable defined and don’t knwo how to best implement the code into the function part
Something like this (you’ll need to adjust the colors to suit your needs)
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
Example usage:
chtMarker.SeriesCollection(1).Values = rngRow
ApplyColorScheme chtMarker, thmColor
chtMarker.Parent.CopyPicture xlScreen, xlPicture
Tags: excel-vbaexcel, vba