2

Как и пользователь 1813558 в своем вопросе "Изменить цвета круговой диаграммы", я бы хотел выбрать цвета, которые Excel использует для круговой диаграммы (даже для любой диаграммы), так как мне нужно, чтобы они соответствовали другим визуализациям данных, которые мы тщательно создали, чтобы дальтоник по-прежнему может участвовать в траловых сессиях данных. Но вместо того, чтобы писать код, я хотел бы сделать это на листе Excel. Можно ли каким-либо образом поместить данные о цвете на лист Excel, например, в виде столбца шестнадцатеричных строк RGB, например 7DFF7D, и указать диаграмму в этом столбце для выбора цвета?

1 ответ1

2

То, что вы хотели бы сделать, невозможно без кода.

Следующая функция VBA может использоваться для установки цветов на основе значений ячеек для круговой диаграммы в активной рабочей таблице. Значения цвета могут быть в диапазоне N строк x 3 столбцов десятичных значений RGB или в диапазоне N строк x 1 столбцов из шестнадцатеричных шестизначных значений (где шестнадцатеричное число представляет собой набор из трех двузначных шестнадцатеричных значений в порядке RGB).

Функция требует двух аргументов: ссылка на диапазон значений цвета (например, A1: A5) и имя круговой диаграммы. Имя диаграммы может быть именем по умолчанию (например, "Диаграмма 2") или именем, заданным для диаграммы.

Если количество столбцов во входном диапазоне не равно 3 или 1, или количество строк не равно количеству точек данных на круговой диаграмме, функция возвращает # N/A! ошибка.

Перекрашенная диаграмма сохранит новые цвета после удаления функции с листа.

Option Explicit

  Function SETPIECOLORS(colorRng As Range, chartName As String) As Variant    
      Dim colorArr As Variant
      Dim myChartObject As ChartObject
      Dim i As Long
      Set myChartObject = ActiveSheet.ChartObjects(chartName)
'     // Assign RGB decimal color values to array
      If colorRng.Columns.Count = 3 Then
          colorArr = colorRng
'     // Assign RGB hex color values to array
      ElseIf colorRng.Columns.Count = 1 Then
          ReDim colorArr(1 To colorRng.Rows.Count, 1 To 3)
          For i = 1 To colorRng.Rows.Count
              colorArr(i, 1) = "&H" & Left(colorRng(i).Value, 2)
              colorArr(i, 2) = "&H" & Mid(colorRng(i).Value, 3, 2)
              colorArr(i, 3) = "&H" & Mid(colorRng(i).Value, 5, 2)
          Next
      Else
'         // Number of columns in color range not equal to 1 or 3
          SETPIECOLORS = CVErr(xlErrNA)
          Exit Function
      End If
      With myChartObject
          With .Chart.SeriesCollection(1)
              If UBound(colorArr, 1) = .Points.Count Then
'                 // Set the colors of the pie data points
                  For i = 1 To .Points.Count
                      .Points(i).Interior.Color = RGB(colorArr(i, 1), colorArr(i, 2), colorArr(i, 3))
                  Next
              Else
'                 // Number of rows in color range does not equal number of data points
                  SETPIECOLORS = CVErr(xlErrNA)
                  Exit Function
              End If
          End With
      End With
      SETPIECOLORS = True
  End Function

Эту функцию можно установить, скопировав ее в новый модуль, вставленный через меню «Разработчик / Visual Basic», доступ к которому осуществляется с ленты Excel.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .