Как сопоставить цвет диаграммы и исходных данных

Автор Дмитрий Якушев На чтение4 мин. Просмотров56

Что делает макрос: При создании информационной панели, вы можете иметь определенные цветовые схемы для различных типов данных. Например, вы можете захотеть, чтобы Северный регион всегда появлялся в определенном цвете, или вы можете захотеть, чтобы некоторые продукты имели цвет товарного знака. Макрос позволяет автоматически менять цвета графика в соответствии с цветом исходного диапазона. Идея заключается в том, что вы можете сопоставить цвет диаграммы и исходных данных, взяв цветовой код ячейки в диапазоне источника, а затем применить те же цвета для каждой соответствующей диаграммы серии. Рисунок дает представление о том, как она работает.

Этот макрос не может захватить цвета, которые были применены с помощью условного форматирования или цвета умных таблиц.

Содержание

1. Как макрос работает
2. Код макроса
3. Как этот код работает
4. Как использовать

Как макрос работает

Все карты имеют объект SeriesCollection, который содержит различные серии данных. В этом макросе, мы выполняем цикл через все серии.
В этом случае мы устанавливаем цвет на цвет диапазона источника. Мы определяем диапазон источника для каждой серии и оцениваем формулу. Формула серия содержит адрес диапазона исходных данных. Проходя этот адрес объекта диапазона, мы можем захватить точный
цвет клеток, а затем использовать его в графике

Код макроса

Sub SopostavitCvetDiagrammiIIshodnihDannih() 'Шаг 1: Объявляем переменные Dim oChart As Chart Dim MySeries As Series Dim FormulaSplit As Variant Dim SourceRangeColor As Long   'Шаг 2: Наведите курсор на активный график On Error Resume Next Set oChart = ActiveChart   'Шаг 3: Выход не был выбран ни один график If oChart Is Nothing Then     MsgBox "График не выбран." Exit Sub End If   'Шаг 4: Цикл через серию диаграмм For Each MySeries In oChart.SeriesCollection       'Шаг 5: Получить диапазон исходных данных для целевой серии     FormulaSplit = Split(MySeries.Formula, ",")(2)           'Шаг 6: Захват цвета в первой ячейке     SourceRangeColor = Range(FormulaSplit).Item(1).Interior.Color       'Шаг 7: Применить окраску     On Error Resume Next     MySeries.Format.Line.ForeColor.RGB = SourceRangeColor     MySeries.Format.Line.BackColor.RGB = SourceRangeColor     MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor     If Not MySeries.MarkerStyle = xlMarkerStyleNone Then         MySeries.MarkerBackgroundColor = SourceRangeColor         MySeries.MarkerForegroundColor = SourceRangeColor     End If       'Шаг 8: Переход к следующей серии Next MySeries   End Sub

Как этот код работает

1. Шаг 1 объявляет четыре переменные. Мы используем oChart в качестве контейнера памяти для нашего графика, MySeries как контейнер памяти для каждой серии в нашей диаграмме, FormulaSplit для захвата и сохранения диапазона исходных данных и SourceRangeColor для захвата и хранения индекса цвета исходного диапазона.
2. Этот макрос разработан так, что мы выводим целевой график на основе выбора графика. Другими словами, для запуска этого макроса должна быть выбрана диаграмма. Предполагается, что мы хотим выполнить действие макроса на графике, на котором мы щелкнули. На шаге 2 мы устанавливаем переменную oChart в ActiveChart. Если диаграмма не выбрана, то выдается ошибка. Именно поэтому мы используем On Error Resume Next Statement. Он говорит Excel продолжить макрос, если есть ошибка.
3. Шаг 3 проверяет, заполняется ли переменная oChart объект диаграммы. Если переменная oChart устанавливается в Nothing, ни один график не был выбран перед запуском макроса. Если это так, то мы говорим пользователю в окне сообщения, а затем выходим из процедуры.
4. Шаг 4 запускает цикл через все активные графики SeriesCollection. Каждая диаграмма имеет формулу серии. Формула серии содержит ссылки на таблицу, указывая на ячейки, используемые для её создания. Типичная серия формула выглядит следующим образом:
   = SERIES (Лист1 $ F $ 6, Лист1 $ D $ 7:! $ D $ 10, Лист1 $ F $ 7: $ F $ 10,2)
   Следует отметить, что существуют три различных диапазона в формуле. Первая точка диапазона на имена серии, вторая точка диапазона на этикетка данных серии, а точки третьего диапазона — это значения данных серии.
5. Шаг 5 использует функцию Split, чтобы извлечь из диапазона значения рядов данных.
6. Шаг 6 захватывает индекс цвета первой ячейки в диапазоне исходных данных. Мы предполагаем, что первая ячейка будет отформатирована так же, как и все остальные части диапазона.
7. После того, как у нас есть индекс цвета, мы можем применить цвет к различным свойствам серии.
8. На последнем этапе, мы делаем цикл, чтобы получить следующую серию. После того, как мы прошли через все ряды данных в таблице, макрос заканчивается.

'=========================================================================================================

'Для обычного графика

Sub test_SopostavitCvetDiagrammiIIshodnihDannih()

ActiveSheet.ChartObjects("Диаграмма 1").Activate

vRetVal = Application.InputBox("Укажите любое число(0-1-2):", "Запрос данных", "", Type:=1)

If IsNumeric(vRetVal) Then Call SopostavitCvetDiagrammiIIshodnihDannih(vRetVal)

End Sub

Sub SopostavitCvetDiagrammiIIshodnihDannih(Optional ByVal intTypeData As Integer = 2)

'intTypeData=0 'имя ряда

'intTypeData=1 'подписи

'intTypeData=2'данные

'Шаг 1: Объявляем переменные

Dim oChart As Chart

Dim MySeries As Series

Dim FormulaSplit As Variant

Dim SourceRangeColor As Long

'Шаг 2: Наведите курсор на активный график

On Error Resume Next

Set oChart = ActiveChart

'Шаг 3: Выход не был выбран ни один график

If oChart Is Nothing Then

MsgBox "График не выбран."

Exit Sub

End If

' 'Восстановить стиль

oChart.ClearToMatchStyle

For Each MySeries In oChart.SeriesCollection

Select Case intTypeData

Case 0 'имя ряда

FormulaSplit = Split(MySeries.Formula, ",")(0) 'имя ряда

FormulaSplit = Split(FormulaSplit, "(")(1)

Case 1 'подписи

FormulaSplit = Split(MySeries.Formula, ",")(1) 'подписи

Case 2 'данные

FormulaSplit = Split(MySeries.Formula, ",")(2) 'данные

Case Else

End Select

Dim rRange As Range, rCell As Range

Set rRange = Range(FormulaSplit)

iCh = 1

For Each rCell In rRange.Cells

SourceRangeColor = rCell.Interior.Color

'если одна ячейка,то закрашиваем весь ряд

If intTypeData = 0 Then

'Шаг 7: Применить окраску

On Error Resume Next

MySeries.Format.Line.ForeColor.RGB = SourceRangeColor

MySeries.Format.Line.BackColor.RGB = SourceRangeColor

MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor

If Not MySeries.MarkerStyle = xlMarkerStyleNone Then

MySeries.MarkerBackgroundColor = SourceRangeColor

MySeries.MarkerForegroundColor = SourceRangeColor

End If

Else

Set oPoint = MySeries.Points(iCh)

'Шаг 7: Применить окраску

' On Error Resume Next

' MySeries.Points(iCh).Select

MySeries.Points(iCh).Format.Fill.ForeColor.RGB = SourceRangeColor

MySeries.Points(iCh).Format.Fill.BackColor.RGB = SourceRangeColor

' If Not MySeries.MarkerStyle = xlMarkerStyleNone Then

' MySeries.MarkerBackgroundColor = SourceRangeColor

' MySeries.MarkerForegroundColor = SourceRangeColor

' End If

End If

iCh = iCh + 1

Next

Next MySeries

'c.SeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = _

ThisWorkbook.Sheets(strShName_Sourse_Chart).Cells(r.Cells(i).Row, r.Cells(i).Column - 1).Interior.Color

End Sub

'=========================================================================================================

'Для графика на основе сводной

Sub test_SopostavitCvetDiagrammiIIshodnihDannih_pt()

ActiveSheet.ChartObjects("Диаграмма 1").Activate

vRetVal = Application.InputBox("Укажите любое число(0-1-2):", "Запрос данных", "", Type:=1)

If IsNumeric(vRetVal) Then Call SopostavitCvetDiagrammiIIshodnihDannih_pt(vRetVal)

End Sub

Sub SopostavitCvetDiagrammiIIshodnihDannih_pt(Optional ByVal intTypeData As Integer = 2)

'intTypeData=0 'имя ряда

'intTypeData=1 'подписи

'intTypeData=2'данные

'Шаг 1: Объявляем переменные

Dim oChart As Chart

Dim MySeries As Series

Dim FormulaSplit As Variant

Dim SourceRangeColor As Long

'Шаг 2: Наведите курсор на активный график

On Error Resume Next

Set oChart = ActiveChart

'Шаг 3: Выход не был выбран ни один график

If oChart Is Nothing Then

MsgBox "График не выбран."

Exit Sub

End If

' 'Восстановить стиль

oChart.ClearToMatchStyle

For Each MySeries In oChart.SeriesCollection

Select Case intTypeData

Case 0 'имя ряда

FormulaSplit = Split(MySeries.Formula, ",")(0) 'имя ряда

FormulaSplit = Split(FormulaSplit, "(")(1)

Case 1 'подписи

FormulaSplit = Split(MySeries.Formula, ",")(1) 'подписи

Case 2 'данные

FormulaSplit = Split(MySeries.Formula, ",")(2) 'данные

Case Else

End Select

Dim rRange As Range, rCell As Range

Set rRange = Range(FormulaSplit)

'dd = rRange.Columns.Count

'ds = rRange.Rows.Count

LngRow = 0 'для проверки номера строки подписи

iCh = 1

For Each rCell In rRange.Cells

If rCell.Row <> LngRow Then

SourceRangeColor = rCell.Interior.Color

Debug.Print rCell.Address

'если одна ячейка,то закрашиваем весь ряд

If intTypeData = 0 Then

'Шаг 7: Применить окраску

On Error Resume Next

MySeries.Format.Line.ForeColor.RGB = SourceRangeColor

MySeries.Format.Line.BackColor.RGB = SourceRangeColor

MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor

If Not MySeries.MarkerStyle = xlMarkerStyleNone Then

MySeries.MarkerBackgroundColor = SourceRangeColor

MySeries.MarkerForegroundColor = SourceRangeColor

End If

Else

Set oPoint = MySeries.Points(iCh)

'Шаг 7: Применить окраску

' On Error Resume Next

' MySeries.Points(iCh).Select

MySeries.Points(iCh).Format.Fill.ForeColor.RGB = SourceRangeColor

MySeries.Points(iCh).Format.Fill.BackColor.RGB = SourceRangeColor

' If Not MySeries.MarkerStyle = xlMarkerStyleNone Then

' MySeries.MarkerBackgroundColor = SourceRangeColor

' MySeries.MarkerForegroundColor = SourceRangeColor

' End If

End If

iCh = iCh + 1

LngRow = rCell.Row 'присвоить номер строки

End If

Next

Next MySeries

'c.SeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = _

ThisWorkbook.Sheets(strShName_Sourse_Chart).Cells(r.Cells(i).Row, r.Cells(i).Column - 1).Interior.Color

End Sub