MS, Libreoffice & Google docs

Сегодня разберём задачку, которая вставала перед каждым пользователем 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_о).