Точное определение цвета серии стекированной диаграммы Excel на основе заливки ячеек

Точное определение цвета серии стекированной диаграммы Excel на основе заливки ячеек
Точное определение цвета серии стекированной диаграммы Excel на основе заливки ячеек

(Используя 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

NevaDev, 26 января 2023 г., 20:10