
Рисунок 2.10 – Блок-схема функции CheckInputData.
Блок 1 – ввод исходных данных в текстовые поля формы.
Блок 2 – проверка введенных данных на допустимость: если данные верны, то выполняются блоки 4-10, иначе – выполняется блок 3 и выход из процедуры.
Блок 4 – проверка введенных данных на допустимость: если данные верны, то выполняются блоки 5-10, иначе – выполняется блок 6 и выход из процедуры.
Блок 3 – присвоение переменной отрицательного результата.
Блок 5 – присвоение переменной значения из текстового поля.
Блок 6 – присвоение переменной отрицательного результата.
Блок 7 – проверка введенных данных на допустимость: если данные верны, то выполняются блоки 8-10, иначе – выполняется блок 9 и выход из процедуры.
Блок 9 – выполнение расчетов угла.
Блок 10 – присвоение переменной положительного результата.
Схема алгоритма функции Diagram представлена на рисунке 2.11.

Рисунок 2.11 – Блок-схема функции Diagram.
Блок 1 – присвоение переменной значения из текстового поля.
Блок 2 – выполнение расчетов.
Блок 3 – вывод изображения в память компьютера.
Схема алгоритма функции Recompare представлена на рисунке 2.12.

Рисунок 2.12 – Блок-схема функции Recompare.
Блок 1 – присвоение переменной значения из текстового поля.
Блок 2 – выполнение расчетов.

Рисунок 3 – Пользовательская форма
Userform – пользовательская форма, которая предназначена для отображения основных элементов управления.
Label1 – надпись, которая предназначена для отображения текста «Длина кривошипа».
Label2 – надпись, которая предназначена для отображения текста «Начальный угол».
TextBox1 – текстовое поле, которое предназначено для ввода длины кривошипа.
TextBox2 – текстовое поле, которое предназначено для ввода начального угла.
TextBox3 – текстовое поле,
которое предназначено для вывода длины
кулисы
.
TextBox4 – текстовое поле,
которое предназначено для вывода длины
кулисы
.
TextBox4 – текстовое поле,
которое предназначено для вывода
межосевого расстояния
.
TextBox5 – текстовое поле,
которое предназначено для вывода
расстояния
.
TextBox6 – текстовое поле, которое предназначено для вывода расстояния до точки C Y.
Compare – кнопка, предназначенная
для расчета длин
,
,
,
,
Y и вывода их в
текстовые поля.
Run – кнопка, которая предназначена для отображения анимации механизма на рабочем листе.
Cancel – кнопка выхода из формы.
Clear – кнопка, которая предназначена для очистки пользовательской формы.
BuildDiagram – кнопка, которая предназначена для рисования графиков скорости, перемещения и ускорения.
Image1 – элемент управления, который предназначен для отображения изображения графика перемещения.
Image2 – элемент управления, который предназначен для отображения изображения графика скорости.
Image3 – элемент управления, который предназначен для отображения изображения графика ускорения.
Const Pi = 3.14159265358979
Dim y, O2B, o2d, o1o2, value As Double
Private Sub Workbook_Open()
Kurs.Show
End Sub
Private Sub CommandButton2_Click()
Kurs.Hide
End Sub
Private Sub UserForm_Initialize()
Image1.PictureAlignment = fmPictureAlignmentTopLeft
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image2.PictureAlignment = fmPictureAlignmentTopLeft
Image2.PictureSizeMode = fmPictureSizeModeStretch
Image3.PictureAlignment = fmPictureAlignmentTopLeft
Image3.PictureSizeMode = fmPictureSizeModeStretch
Frame.Visible = False
End Sub
'Кнопка Механизм'
Private Sub CommandButton3_Click()
If Not IsNumeric(LO1A.Text) Then
MsgBox "Длина кривошипа должна быть числом", vbOKOnly, "Повторите ввод..."
TextBox1 = ""
TextBox1.SetFocus
Exit Sub
End If
If LO1A <= 0 Then
MsgBox "Длина кривошипа должна быть больше 0", vbOKOnly, "Повторите ввод..."
TextBox1 = ""
TextBox1.SetFocus
Exit Sub
End If
If Not IsNumeric(fi1.Text) Then
MsgBox "Значение угла должно быть числом", vbOKOnly, "Повторите ввод..."
TextBox2 = ""
TextBox2.SetFocus
Exit Sub
End If
O1A = CInt(LO1A.Text)
f1 = CInt(fi1.Text) * Pi / 180
xo1 = 100: yo1 = 100
o1o2 = 3 * O1A: y = 2.4 * O1A: O2B = 4.5 * O1A: o2d = 3 * O1A
For f = 0 + f1 To 2 * Pi + f1 Step Pi / 60
xA = xo1 - O1A * Cos(f)
yA = yo1 + O1A * Sin(f)
xo2 = xo1 + o1o2
yo2 = yo1
phi1 = Atn((yo2 - yA) / (xo2 - xA))
phi2 = Pi / 2 - phi1
phi3 = Pi / 2 - phi2
yB = yo1 - (O2B * Sin(phi1))
ro2 = Sqr((O2B) ^ 2 - (yB - yo1) ^ 2)
xB = xo1 - (ro2 - o1o2)
phi4 = Pi / 2 - phi3
phi5 = (Pi / 2) - phi4
O2C = y / Cos(phi5)
If f >= 0 And f <= 1 * Pi Or f >= 2 * Pi And f <= 3 * Pi Then
xC = xo1 + (o1o2 - Sqr((O2C) ^ 2 - (y) ^ 2))
Else
xC = xo1 + (o1o2 + Sqr((O2C) ^ 2 - (y) ^ 2))
End If
yC = yo1 - y
yD = yo1 - (o2d * Cos(phi5))
If f >= 0 And f <= 1 * Pi Or f >= 2 * Pi And f <= 3 * Pi Then
xD = xo1 + (o1o2 - Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
Else
xD = xo1 + (o1o2 + Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
End If
ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, xo1 - 3, yo1, 6, 6).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, xo2 - 3, yo2, 6, 6).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, xC - 5, yC - 2, 10, 4).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, xA - 5, yA - 2, 10, 4).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddLine(xo1, yo1, xA, yA).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xo2, yo2, xB, yB).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xC, yC, xo2, yo2).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xD, yD, xC, yC).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xC, yC, xC - O1A * 3, yC).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xo2 - O1A * 2, yC - 2, xo2 - y, yC - 2).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddLine(xo2 - O1A * 2, yC + 2, xo2 - y, yC + 2).Line.ForeColor.RGB = RGB(0, 0, 250)
ActiveSheet.Shapes.AddShape(msoShapeOval, xA - 1, yA - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeOval, xC - 1, yC - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeOval, xo1 - 1, yo1 - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddShape(msoShapeOval, xo2 - 1, yo2 - 1, 2, 2).Line.ForeColor.RGB = RGB(0, 0, 0)
Clock 0.01
ActiveSheet.Shapes.SelectAll
Selection.Delete
Next f
End Sub
Private Sub Clear_Click()
Cells.Clear
ActiveSheet.Shapes.SelectAll
Selection.Delete
Image1.Picture = LoadPicture("")
Image2.Picture = LoadPicture("")
Image3.Picture = LoadPicture("")
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Frame.Visible = False
End Sub
Sub Clock(PauseTime)
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub
Private Sub BuildDiagram_Click()
Dim fi As Double, L As Double
Dim input_text As Boolean
Dim iter As Integer
return_value = CheckInputData(LO1A.Text, fi1.Text, L, fi)
If (return_value = False) Then
MsgBox "Ошибка исходных данных", vbCritical, "Сообщение об ошибке"
Exit Sub
End If
angle = fi
For iter = 1 To 13
Call WriteDataOnList(angle, L, iter)
angle = angle + Pi / 6
Next iter
Call DrawGraphics
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
Function CheckInputData(ByVal L_text As String, ByVal fi1_text As String, _
ByRef L As Double, ByRef fi As Double)
If (IsNumeric(L_text)) Then
If (CDbl(L_text) > 0) Then
L = CDbl(L_text)
Else
CheackInputData = False
Exit Function
End If
Else
CheackInputData = False
Exit Function
End If
If (IsNumeric(f1_text)) Then
fi = CDbl(fi1_text) * Pi / 180
Else
CheackInputData = False
Exit Function
End If
CheckInputData = True
End Function
Sub WriteDataOnList(ByVal angle As Double, ByVal L As Double, ByVal iterator As Integer)
Worksheets(2).Range("A" & iterator) = iterator - 1
Worksheets(2).Range("B" & iterator) = Recompare(angle, L)
Worksheets(2).Range("C" & iterator) = iterator - 1
Worksheets(2).Range("D" & iterator) = (Recompare(angle + 0.000001, L) - Recompare(angle - 0.000001, L)) / 0.000001
Worksheets(2).Range("E" & iterator) = iterator - 1
Worksheets(2).Range("F" & iterator) = (Recompare(angle + 0.001, L) - 2 * Recompare(angle, L) + Recompare(angle - 0.001, L)) / 0.001 ^ 2
End Sub
Function Recompare(ByVal angle As Double, ByVal L_value As Double)
O1A = L_value
xo1 = 0: yo1 = 0
o1o2 = 3 * O1A: y = 2.4 * O1A: O2B = 4.5 * O1A: o2d = 3 * O1A
xA = xo1 - O1A * Cos(angle)
yA = yo1 + O1A * Sin(angle)
xo2 = xo1 + o1o2
yo2 = yo1
phi1 = Atn((yo2 - yA) / (xo2 - xA))
phi2 = Pi / 2 - phi1
phi3 = Pi / 2 - phi2
yB = yo1 - (O2B * Sin(phi1))
ro2 = Sqr((O2B) ^ 2 - (yB - yo1) ^ 2)
xB = xo1 - (ro2 - o1o2)
phi4 = Pi / 2 - phi3
phi5 = (Pi / 2) - phi4
O2C = y / Cos(phi5)
If angle >= 0 And angle <= 1 * Pi Or angle >= 2 * Pi And angle <= 3 * Pi Then
xC = xo1 + (o1o2 - Sqr((O2C) ^ 2 - (y) ^ 2))
Else
xC = xo1 + (o1o2 + Sqr((O2C) ^ 2 - (y) ^ 2))
End If
yC = y
yD = o2d * Cos(phi5)
If angle >= 0 And angle <= 1 * Pi Or angle >= 2 * Pi And angle <= 3 * Pi Then
xD = xo1 + (o1o2 - Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
Else
xD = xo1 + (o1o2 + Sqr((o2d) ^ 2 - (yo1 - yD) ^ 2))
End If
Recompare = yD
End Function
Sub DrawLink(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
With ActiveSheet.Shapes.AddLine(screenX + x1, screenY - y1, screenX + x2, screenY - y2)
.Line.BeginArrowheadStyle = msoArrowheadOval
.Line.EndArrowheadStyle = msoArrowheadOval
End With
End Sub
Sub DrawGraphics()
Const count_cell = 13
Image1.Picture = LoadPicture(Diagram("A1:B" & count_cell, "График перемещения"))
Image2.Picture = LoadPicture(Diagram("C1:D" & count_cell, "График скорости"))
Image3.Picture = LoadPicture(Diagram("E1:F" & count_cell, "График ускорения"))
End Sub
Function Diagram(o, name)
cells_range = o
Range(cells_range).Select
Charts.Add
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SetSourceData Source:=Sheets("Лист2").Range(cells_range)
ActiveChart.Location Where:=xlLocationAsObject, name:="Лист2"
ActiveChart.SeriesCollection(1).Smooth = True
ActiveChart.Legend.Delete
ActiveChart.ChartWizard , , , , , , , Title:=name
ActiveChart.Export ActiveWorkbook.Path & "\ss.gif"
Worksheets(2).ChartObjects.Delete
Worksheets(2).Range(cells_range) = ""
Worksheets(2).Cells(1, 1).Select
Diagram = ActiveWorkbook.Path & "\ss.gif"
End Function
Private Sub Compare_Click()
Dim fi As Double, L As Double
Dim input_text As Boolean
return_value = CheckInputData(LO1A.Text, fi1.Text, L, fi)
If (return_value = False) Then
MsgBox "Ошибка исходных данных", vbCritical, "Сообщение об ошибке"
Exit Sub
End If
Call Recompare(fi, L)
Text1 = "DO2:" & o2d
Text2 = "BO2:" & O2B
Text3 = "O1O2:" & o1o2
Text4 = "y:" & y
Frame.Visible = True
End Sub
Переменные объявляются следующим образом:
Dim <Имя переменной> [As Тип]
Типы переменных:
Double – число с плавающей запятой двойной точности;
Integer – целое число, размер которого не гарантируется.
Оператор цикла For позволяет повторять группу операторов заданное
число раз. Синтаксис:
For<счётчик цикла>=<начало>TO <конец>[step<шаг>]
<тело цикла>
[Exit For]
Next [<счетчик_цикла>]
Здесь <счетчик_цикла> – это числовая переменная. В начале выполнения цикла она принимает значение, задаваемое числом выражением <начало>. Числовое выражение <конец> - задает заключительное выражение счетчика цикла. Числовое выражение <шаг> не обязательно и по умолчанию равно 1.
<Тело цикла> – это последовательность операторов, которая будет выполнена заданное количество раз. Это условие проверяется перед началом выполнения цикла, а затем после каждого прибавления шага к счетчику цикла в операторе Next. Если оно выполнено, управление передается на оператор следующий за Next, нет – выполняются операторы из тела цикла. Завершить цикл For…Next можно и с помощью оператора Exit For. Такие операторы могут быть расположены в тех местах тела цикла, где требуется из него выйти, не дожидаясь выполнения условия завершения. Параметр типа As тип позволяет явно задать тип данных, который возвращает функция. Если он опущен, то по умолчанию возвращается значение типа Variant. Внутри функции имеется инструкция имя = выражение, которая используется для задания возвращаемого значения.
Подпрограмма–функция – является самостоятельной частью программного кода, имеет свое имя, может иметь параметры, возвращает в вызывающую программу значение, присвоенное её имени. Синтаксис:
[Private Public] Function <имя функции> ([<список параметров>])
<операторы>
[Exit Function]
< операторы >
End Function
Public – ключевое слово, указывающее на то, что функция доступна
во всех модулях проекта. Эта область действия функции принята по умолчанию, поэтому использовать ключевое слово Public при объявлении функции не обязательно.
<имя функции> – Имя функции, которое удовлетворяет всем правилам создания идентификатора в VBA
([<список параметров>]) – это список параметров, значения которых передаются в функцию или возвращаются из функции.
Разделителем в списке формальных параметров является запятая.
<операторы> – группа инструкций, выполняемых в функции.
[Exit Function] – оператор, приводящий к немедленному выходу из функции.
Оператор ветвления if позволяет выбирать и выполнять действия в зависимости от истинности некоторого условия. Имеется два варианта синтаксиса:
Однострочная форма записи условного оператора:
IF <условие> Then <операторы 1> Else <операторы 2>
Здесь условие обязательно в обоих вариантах. Оно может быть числовым или строковым выражением со значениями TRUE или FALSE.Если условие истинно (TRUE), выполняется последовательность “операторы 1”, если ложно, “операторы 2”.
Функция IsNumeric проверяет, является ли значение данного выражения числом. Функция способна обрабатывать данные любого типа без генерации ошибки.
Синтаксис: IsNumeric(условие)
<операторы> – группа инструкций, выполняемых в процедуре.
Объект Shape — это любой графический объект, размешенный на рабочем листе или диаграмме. Семейство Shapes представляет собой семейство всех графических объектов рабочего листа.
Сначала задается свойство, которое возвращает объект, содержащий устанавливаемые свойства, а уж потом для этого объекта определяется требуемое свойство. Например, если надо изменить тип линии, то у выбранного объекта семейства ShapeRange используется свойство Line, которое возвращает объект LineFormat, содержащий свойства для установки цвета, толщины и типа граничных линий объекта Shape. Получив таким образом объект LineFormat, при помощи его свойств устанавливается конкретный тип линии.