Как использовать VBA для раскраски круговой диаграммы
У меня есть следующий код, в котором код пытается создать пузырьковую диаграмму с круговыми диаграммами в качестве пузырьков. Так как в этой версии цветовые темы используются для создания разных цветов в каждой круговой диаграмме (пузырьке) в функциональной части, у меня есть проблема в том, что она работает в зависимости от путей к цветовой палитре.
Существует ли простой способ сделать функцию так, чтобы она работала независимо от этих путей, либо путем кодирования цвета для каждого сегмента круговой диаграммы, либо с использованием стандартизированных путей (вероятно, это невозможно, не желательно).
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
Код снова и снова копирует одну диаграмму на пузырьках. Поэтому я хотел бы изменить функцию (теперь она называется Get colourscheme) на функцию, которая присваивает уникальный цвет RGB каждому сегменту каждой круговой диаграммы. Подобная проблема обсуждается здесьИзменить цвет точек в диаграмме Excel VBA но код, очевидно, не работал для человека, который спрашивал. Кто-нибудь может дать мне какой-нибудь совет о том, как переписать функциональную часть кода
Мой грубый подход был бы:
выберите лист и затем захватите каждый график после того, как он скопированизменить цвет каждого сегмента с помощью уникального кода RGBНо как я внедрил бы это в VBA, мне не ясно. Я был бы очень признателен за любые комментарии по этому вопросу.