Сегодня расскажу про простой способ разукрасить диаграммы, а именно заменить маркеры на произвольные рисунки.
Установка рисунков в качестве маркеров позволяет разнообразить внешний вид документации, сделав её нагляднее. Установка смайлов (© http://www.kolobok.us/ ) сделана в качестве примера (помните про Aiwan то? Или забыли...).
Для гармоничного отображения требуется проредить количество маркеров, в противном случае произойдёт наложение рисунков друг на друга. О прореживании писал ранее.
Заменить маркеры на рисунки, в данном случае они представлены смайлами, можно при помощи не сложного макроса
Sub Markers_Smiles()
ActiveSheet.ChartObjects("Диаграмма 1").Activate
For Each icell In [C2:C102]
ActiveChart.FullSeriesCollection(1).Points(icell.Row - 1).Select
' Убираю рамки вокруг маркеров
Selection.MarkerForegroundColorIndex = xlNone
' Установка типа маркера «Рисунок»
Selection.MarkerStyle = -4147
Selection.Format.Fill.UserPicture "D:\4.gif"
If icell.Value = 0 Then Selection.Format.Fill.UserPicture "D:\1.gif"
If icell.Value = 1 Then Selection.Format.Fill.UserPicture "D:\2.gif"
If icell.Value = 2 Then Selection.Format.Fill.UserPicture "D:\3.gif"
Next
End Sub
Где
[C2:C102] - столбец с признаками маркера. Число элементов равно числу данных (Х или Y). Может как заполняться вручную, так и быть расчётным (см.рисунок ниже).
D:\1.gif ... D:\4.gif - пути к рисункам.
Аналогично производится заполнение рисунками нескольких графиков на диаграмме
Прореживаем
Sub Прореживание_маркеров()
' Активируем диаграмму
ActiveSheet.ChartObjects("Диаграмма 1").Activate
' Перебор по всем графикам диаграммы
For k = 1 To ActiveChart.FullSeriesCollection.Count
' Удаляем все маркеры на линии
For i = 1 To ActiveChart.SeriesCollection(k).Points.Count
ActiveChart.FullSeriesCollection(k).Points(i).Select
Selection.MarkerStyle = -4142
Next i
' Выставляем маркеры с требуемым шагом.
For i = 1 To ActiveChart.SeriesCollection(k).Points.Count Step 4
ActiveChart.FullSeriesCollection(k).Points(i).Select
With Selection
.MarkerStyle = 8
.MarkerSize = 15
End With
Next i
Next k
End Sub
Проставляем рисунки
Public Sub color_graph()
ActiveSheet.ChartObjects("Диаграмма 1").Activate
For k = 1 To ActiveChart.FullSeriesCollection.Count ' Перебор по всем графикам
For Each icell In [C2:C102]
ActiveChart.FullSeriesCollection(k).Points(icell.Row - 1).Select
Selection.MarkerStyle = -4147
Selection.Format.Fill.UserPicture "D:\4.gif"
If icell.Value = 0 Then Selection.Format.Fill.UserPicture "D:\1.gif"
If icell.Value = 1 Then Selection.Format.Fill.UserPicture "D:\2.gif"
If icell.Value = 2 Then Selection.Format.Fill.UserPicture "D:\3.gif"
Next
Next k
End Sub
Аналогично разным графикам одной диаграммы можно присвоить уникальные маркеры
Sub Markers()
ActiveSheet.ChartObjects("Диаграмма 1").Activate
For i = 1 To ActiveChart.FullSeriesCollection.Count ' Перебор по всем графикам
ActiveChart.FullSeriesCollection(i).Select
Selection.MarkerForegroundColorIndex = xlNone
Selection.MarkerStyle = -4147
If i = 1 Then Selection.Format.Fill.UserPicture "D:\1.gif"
If i = 2 Then Selection.Format.Fill.UserPicture "D:\2.gif"
If i = 3 Then Selection.Format.Fill.UserPicture "D:\3.gif"
If i = 4 Then Selection.Format.Fill.UserPicture "D:\4.gif"
If i = 5 Then Selection.Format.Fill.UserPicture "D:\5.gif"
Next i
End Sub
Ну или просто разными штатными маркерами разные графики. Но в автоматическом режиме - очень сокращает время подготовки документации. Полезно при подготовке к печати в чёрно-белом варианте.
Sub Установка_разных_маркеров()
ActiveSheet.ChartObjects("Диаграмма 1").Activate
For i = 1 To ActiveChart.FullSeriesCollection.Count ' Перебор по всем графикам
ActiveChart.FullSeriesCollection(i).Select
Selection.Format.Line.ForeColor.RGB = RGB(0, 0, 0) ' Цвета линий и маркера
Selection.Format.Line.Weight = 0.75 ' Установка толщины линии
Selection.MarkerStyle = i ' Установка типа маркера
Selection.MarkerSize = 4 ' Установка размера маркера
Selection.Format.Fill.ForeColor.RGB = RGB(255, 255, 255) ' Установка заливки маркера
Next i
End Sub
Можно ли это сделать без макросов? Несомненно. Долго и нудно кликать кнопочки.
Но как по мне - проще скопировать и немного поправить код простого макроса. А в остальном - ваш выбор.
