изменяя срез цвет круговой диаграммы в Excel VBA

Question

Сначала я написал функцию, которая меняет внешний вид серии пирог-карт в соответствии с заранее определенными цветовыми темами

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. я нашел здесь, на StackOverflow в теме previosu (How to use VBA to colour pie chart) способ изменить цвет каждого среза круговой диаграммы

, но я не knwo, как реализовать код в функции упомянутой выше. Могу ли я потенциально написать

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 и не знаю, как наилучшим образом реализовать код в функциональной части

Answer 1

Что-то вроде этого (вам нужно настроить цвета в соответствии с вашими потребностями)

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