(Используя Excel 365 for Enterprise) Я регулярно создаю диаграммы со сложенными столбцами, где серии берутся из фиксированного списка категорий, и каждая категория должна иметь определенный (заданный извне) цвет.
В каждой диаграмме данные должны быть упорядочены по распространенности, поэтому иногда данная категория может отображаться как Серия 1, иногда как Серия 12 и так далее. Вставка новых данных в существующий лист/диаграмму означает несоответствие цветов и категорий. Ранее я вручную устанавливал заливку каждой серии (пользовательские значения RGB) для каждого нового графика, но хотелось бы быть более эффективным.
есть макрос VBA, который может установить цвет серии диаграмм на основе цвета заливки ячейки, содержащей данные (мои ячейки данных используют правильные цвета, как показано на рисунке ниже):
'Source https://www.get-digital-help.com/format-fill-color-on-a-column-chart-based-on-cell-color/#bar
'Name macro
Sub ColorChartBarsbyCellColor()
'Dimension variables and declare data types
Dim txt As String, i As Integer
'Save the number of chart series to variable c
c = ActiveChart.SeriesCollection.Count
'Iterate through chart series
For i = 1 To c
'Save seriescollection formula to variable txt
txt = ActiveChart.SeriesCollection(i).Formula
'Split string save d to txt using a comma ","
arr = Split(txt, ",")
'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
With ActiveChart.Legend.LegendEntries(i)
'The SET statement allows you to save an object reference to a variable, the image above demonstrates a macro that assigns a range reference to a range object.
'Save a range object based on variable arr to variable vAdress
Set vAddress = ActiveSheet.Range(arr(2))
'Copy cell color from cell and use it to color bar chart
.LegendKey.Interior.Color = ThisWorkbook.Colors(vAddress.Cells(1).Interior.ColorIndex)
End With
'Continue with next series
Next i
End Sub
Похоже, что это работает, поскольку цвета назначаются, но они не совсем правильные. Некоторые близки, другие нет, как на рисунке ниже.
прокомментировали исходную страницу VBA, и автор предоставил дополнительный код для решения этой проблемы, но не ответил тем, кто спрашивал (более года назад), как заставить его работать с оригинальным макросом.
'Source https://www.get-digital-help.com/format-fill-color-on-a-column-chart-based-on-cell-color/#comment-430898
Sub ColorChartColumnsbyCellColor()
With Sheets("Color chart columns").ChartObjects(1).Chart.SeriesCollection(1)
Set vAddress = ActiveSheet.Range(Split(Split(.Formula, ",")(1), "!")(1))
For i = 1 To vAddress.Cells.Count
CS = ThisWorkbook.Colors(vAddress.Cells(i).Interior.ColorIndex)
R = CS Mod 256
G = CS \ 256 Mod 256
B = CS \ 65536 Mod 256
.Points(i).Format.Fill.ForeColor.RGB = RGB(R, G, B)
Next i
End With
End Sub
Мне кажется, что я близок к решению, но упираюсь в последнее препятствие. Возможно ли добавить второй блок кода в первый блок, чтобы сделать рабочий макрос, который будет точно устанавливать цвет серии графиков от заполнения ячейки данных? Спасибо.
Исходные ссылки для удобства: основной код и дополнительный блок.
Sub ColorChartBarsbyCellColor()
Dim nSrs As Long
nSrs = ActiveChart.SeriesCollection.Count
'Iterate through chart series
Dim iSrs As Long
For iSrs = 1 To nSrs
'Get series formula
Dim sFmla As String
sFmla = ActiveChart.SeriesCollection(iSrs).Formula
'Split series formula at commas "," to create array
Dim vFmla As Variant
vFmla = Split(sFmla, ",")
' Find Y value range
Dim rYValues As Range
Set rYValues = Range(vFmla(2))
'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
With ActiveChart.SeriesCollection(iSrs)
'Copy cell color from cell and use it to color bar chart
.Format.Fill.ForeColor.RGB = rYValues.Interior.Color
End With
Next iSrs
End Sub