Офисное программирование

Нажатие кнопки Отмена запускает на выполнение процедуру CommandButton2_C1ick

Закрывает диалоговое окно.

Рассмотрим листинг данного приложения.

Private Sub CommandButton1_Click

' Процедура табуляции функции

Dim х_нз As Double

Dim х_пз As Double

Dim х_шаг As Double

Dim УрГрафика As String

Dim nx As Integer

'nx – число протабулированных значений аргумента х

Dim n As Integer

Dim i As Integer

'n,i – вспомогательные целые переменные

'Проверка корректности ввода данных

If IsNumeric(TextBox2.Text) = False Then

MsgBox «Ошибка в начальном значении х», vbInformation, «График»

TextBox2.SetFocus

Exit Sub

End If

If IsNumeric(TextBox3.Text) = False Then

MsgBox «Ошибка в шаге х», vbInformation, «График»

TextBox3.SetFocus

Exit Sub

End If

If IsNumeric(TextBox4.Text) = False Then

MsgBox «Ошибка в конечном значении у», vbInformation, «График»

TextBox4.SetFocus

Exit Sub

End If

'Считывание с диалогового окна значений переменных

х_нз = CDbl(TextBox2.Text)

х_шаг = CDbl(TextBox3.Text)

х_пз = CDbl(TextBox4.Text)

УрГрафика = Trim(TextBox1.Text)

'Проверка согласованности введенных данных

If х_нз >= х_пз Then

MsgBox «Начальное значение х слишком большое», vbInformation, «График»

TextBox2.SetFocus

Exit Sub

End If

If х_нз + х_шаг >= х_пз Then

MsgBox «Шаг х великоват», vbInformation, «График»

TextBox3.SetFocus

Exit Sub

End If

'Замена в введенной формуле аргумента х на ссылку $A1

i = 1

Do

'Замена в введенной формуле аргумента х на ссылку $A1

If Mid(УрГрафика, i, 1) = «x» Or Mid(УрГрафика, i, 1) = «X» Then

n = Len(УрГрафика)

If (1 < i) And (i < n) Then

УрГрафика = Left(УрГрафика, i – 1) & «$A1» & Right(УрГрафика, n – i)

End If

If i = 1 Then

УрГрафика = «$A1» & Right(УрГрафика, n – 1)

End If

If i = n Then

УрГрафика = Left(УрГрафика, n – 1) & «$A1»

End If

End If

i = i + 1

Loop While i <= Len(УрГрафика)

ActiveSheet.Cells.Select

Selection.Clear

'Очистка на активном листе ранее введенных данных

ActiveSheet.Range(«A1»).Select

'Заполнение диапазонов значениями аргумента

With ActiveSheet

Range(«A1»).Value = х_нз 'Ввод в ячейку A1 начального значения

'Создание арифметической прогрессии по столбцу с указанным шагом и начальным значением

Range(«A1»).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=х_шаг, Stop:=х_пз, Trend:=False

End With

'Заполнение диапазона значениями функции

With ActiveSheet

nx = Range(«A1»).CurrentRegion.Rows.Count

'Определение числа строк в диапазоне заполнения

Range(«B1»).FormulaLocal = УрГрафика

'Ввод уравнения поверхности в ячейку B1

If IsError(Evaluate(УрГрафика)) = True Then

MsgBox «Ошибка в формуле», vbExclamation, «График»

Exit Sub

End If

'Заполнение диапазона Range(Cells(1, 2), Cells(nx, 2))

'начиная с ячейки B1, что эквивалентно протаскиванию маркера

'заполнения ячейки B1 на диапазон Range(Cells(1, 2),

Cells(nx, 2))

Range(«B1»).AutoFill Destination:=Range(Cells(1, 2), Cells(nx, 2)), Type:=xlFillDefault

End With

ActiveSheet.ChartObjects.Delete

'Удаление с рабочего листа всех ранее построенных диаграмм

ActiveSheet.Range(Cells(1, 2), Cells(nx, 2)).Select

'Выбор диапазона, по которому строится график

ActiveSheet.ChartObjects.Add(20, 19.5, 192, 192).Select

'Задание и выбор области на рабочем листе, где будет построен график,

'размер графика должен соответствовать размеру объекта Image1

Application.CutCopyMode = False

'Построение графика

ActiveChart.ChartWizard Source:=Range(Cells(1, 1), Cells(nx, 2)), Gallery:=xlLine, Format:=2, PlotBy:=xlColumns, CategoryLabels:=1, SeriesLabels:=0, HasLegend:=False, Title:="График",

CategoryTitle:="Аргумент", ValueTitle:="Функция y" & TextBox1.Text

ActiveSheet.ChartObjects(1).Activate

ActiveChart.Axes(xlValue).AxisTitle.Select

With Selection

HorizontalAlignment = xlCenter

VerticalAlignment = xlCenter

Orientation = xlUpward

End With

'Запись диаграммы в файл и загрузка картинки в Imagel

ActiveChart.Export Filename:="Graph.jpg",

FilterName:="JPEG"

UserForm1.Image1.Picture = LoadPicture(«graph.jpg»)

ActiveSheet.Range(«A1»).Select

End Sub

Private Sub CommandButton2 Click

'Процедура закрытия диалогового окна

UserForm1.Hide

End Sub

Private Sub UserForm Initialize

'Рисунок масштабируется с учетом относительных размеров

так, чтобы он помещался в объекте Imagel

With Imagel

PictureAlignment = fmPictureAlignmentTopLeft

PictureSizeMode = fmPictureSizeModeStretch

End With

End Sub