Сегодня разберём задачку, которая вставала перед каждым пользователем Excel - необходимость построить график функции.
Любой, кто решал эту задачку - действовал следующим способом:
1. Создаётся столбец Х;
2. Создаётся столбец Y, котором происходит расчёт согласно заданной функции;
3. Выделяются два созданных столбца и вставляется график.
Но это просто и скучно. Есть другой способ. Построить график непосредственно из макроса.
Начнём с простого - у нас есть набор точек соответствия X и Y.
Sub Построй_график_по_точкам()
Dim MyChart As Chart
Set MyChart = ActiveSheet.Shapes.AddChart2.Chart
With MyChart
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = "xlXYScatterSmoothNoMarkers"
.SeriesCollection(1).XValues = Array(0#, 0.5, 1#, 1.5, 2#, 2.5, 3#, 3.5, 4#, 4.5, 5#)
.SeriesCollection(1).Values = Array(0#, 0.4794, 0.8415, 0.9975, 0.9093, 0.5985, 0.1411, -0.3508, -0.7568, -0.9775, -0.9589)
.ChartType = xlXYScatterLines ' Соединение точек прямыми
.SetElement msoElementLegendNone
End With
End Sub
Другие варианты отображения линии графика:
.ChartType = xlXYScatterLinesNoMarkers ' Соединение точек прямыми без маркеров
.ChartType = xlXYScatterSmoothNoMarkers ' Сглаженная линия
Более подробно о типах - тут
Сборка Array(...) может быть выполнена с использованием программы, которую я выкладывал в 7-й части темы про оцифровку, ну или заполнить руками.
Как не трудно догадаться - вовсе не обязательно иметь готовый набор данных.
Рассмотрим ситуацию, когда требуется построить два графика на одной диаграмме.
Для упрощения восприятия использую две простые функции линий y1 = x - 20, y2 = x + 20.
Sub Создать_диаграмму()
Dim MyChart As Chart
Dim i As Integer, Xmin As Single, dX As Single, Xmax As Single, _
Ymin As Single, Ymax As Single, dY As Single
Dim X() As Single
Dim Y() As Single
Dim Yp() As Single
Xmin = 0: Xmax = 300: dX = 20 ' Сие больше нужно для осей и оформления
Ymin = 0: Ymax = 160: dY = 20
ReDim X(0 To Xmax - Xmin): ReDim Y(0 To Xmax - Xmin, 1 To 2)
ReDim Yp(0 To Xmax - Xmin)
For i = 0 To Xmax - Xmin Step 1
X(i) = Xmin + i
' Заполнение данных первого графика
Y(i, 1) = X(i) - 20
' Заполнение данных второго графика
Y(i, 2) = X(i) + 20
Next i
' создадим новую диаграмму и зададим ей габаириты
Set MyChart = ActiveSheet.Shapes.AddChart2(, , , , 300, 200).Chart
For i = 1 To 2
For j = 0 To Xmax - Xmin Step 1
Yp(j) = Y(j, i)
Next j
With MyChart
.SeriesCollection.NewSeries
.SeriesCollection(i).XValues = X
.SeriesCollection(i).Values = Yp
.ChartType = xlXYScatterSmoothNoMarkers
End With
Next i
End Sub
При задании новой диаграммы можно задать в том числе и положение диаграммы на листе
AddChart2(Стиль,XlChartType,слева,сверху,ширина,высота,NewLayout)
В итоге получим вот такую диаграмму:
В дальнейшем можно обработать её как обычную - задать цвета, толщины и т.д. Но можно это сразу поручить нашему макросу:
Sub Создать_диаграмму()
Dim MyChart As Chart
Dim i As Integer, Xmin As Single, dX As Single, Xmax As Single, _
Ymin As Single, Ymax As Single, dY As Single
Dim X() As Single
Dim Y() As Single
Dim Yp() As Single
Xmin = 0: Xmax = 300: dX = 20 ' Сие больше нужно для осей и оформления
Ymin = 0: Ymax = 340: dY = 20
ReDim X(0 To Xmax - Xmin): ReDim Y(0 To Xmax - Xmin, 1 To 2)
ReDim Yp(0 To Xmax - Xmin)
For i = 0 To Xmax - Xmin Step 1
X(i) = Xmin + i
Y(i, 1) = X(i) - 20
Y(i, 2) = X(i) + 20
Next i
Set MyChart = ActiveSheet.Shapes.AddChart2(, , 0, 0, 400, 230).Chart
For i = 1 To 2
For j = 0 To Xmax - Xmin Step 1
Yp(j) = Y(j, i)
Next j
With MyChart
.SeriesCollection.NewSeries
.SeriesCollection(i).XValues = X
.SeriesCollection(i).Values = Yp
.ChartType = xlXYScatterSmoothNoMarkers
End With
Next i
With MyChart
.SetElement (msoElementPrimaryCategoryGridLinesMajor)
' Включаю отображение названия осей
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Расход Go т/ч"
.Axes(xlValue, xlPrimary).AxisTitle.Text = "Давление кгс/кв.см."
' Выключаю отображение легенды
.SetElement (msoElementLegendNone)
' Выключаю отображения заголовка диаграммы
.SetElement (msoElementChartTitleNone)
' Выставляем параметры осей
.Axes(xlCategory).MinimumScale = Xmin
.Axes(xlCategory).MaximumScale = Xmax
.Axes(xlCategory).MajorUnit = dX
.Axes(xlValue).MinimumScale = Ymin
.Axes(xlValue).MaximumScale = Ymax
.Axes(xlValue).MajorUnit = dY
End With
' Оформление гризонтальной оси
MyChart.Axes(xlCategory).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Visible = msoTrue
.Weight = 1.25
End With
' Оформление вертикальной оси
MyChart.ChartArea.Select
MyChart.Axes(xlValue).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Visible = msoTrue
.Weight = 1.25
End With
' Оформление горизонтальной сетки
MyChart.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineDash
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
End With
' Оформление вертикальной сетки
MyChart.Axes(xlCategory).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.DashStyle = msoLineDash
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
End With
End Sub
По итогу диаграмма будет выглядеть так:
Как не трудно понять, данных, по которым построена диаграмма, на листе нет. И после удаления макроса останется только итоговый результат.
Кому то это покажется слишком сложным, однако открою маленький секрет - очень редкие люди пишут макрос с нуля. В 90% достаточно иметь готовый макрос (см листинг выше), заменить в нём пару строк (сменить функции, изменить диапазоны...) и всё. По итогу построение занимает меньше времени чем построение классическим способом.
Такое построение позволит извлечь данные промежуточного расчёта, построить массово однотипные диаграммы и... и дальнейшее применение зависит только от фантазии.
Ну и всегда есть вариант удивить преподавателя (0_о).
