ActiveSheet.Cells(i, 7) = CStr(O_stoim).
CStr () – строковая функция, которая преобразует число в строку;
MsgBox() – выдаёт окно сообщения;
CDbl() – преобразует строку в число.
3. Тестирование программного модуля
Для запуска программного модуля достаточно открыть документ «КР.xls» и Excel автоматически запустит программу. Это достигается с помощью события Workbook_Open с использованием методов:
Load UserForm1
UserForm1.Show
Пользователь должен ввести исходные данные и запустить расчёт, используя кнопку «Подсчитать». Результат отображается на рабочий лист. Тестовый пример приведен в Приложении Б.
Используя основные критерии оценки эффективности функционирования программного модуля, описанные в пункте «Математическое описание задачи» можно сделать вывод о работоспособности и оптимальности программного модуля.
Заключение
В контрольной работе на тему «Основы программирования на VBA: Модель объектов EXEL» был разработан и реализован программный модуль с пользовательской формой. Программный модуль обеспечивает ввод исходных данных, расчет заданной математической функции и вывод результатов на рабочий лист.
В процессе работы была разработана математическая модель задачи, схема алгоритма, код программы на языке VBA, пользовательский интерфейс и проведено тестирование программного модуля.
Список использованной литературы
1. Р. Петерсон. Microsoft Excel 97 в подлиннике: В 2т.: пер. с англ.-СПб.:BHV-Санкт-Петербург, 1997. Том 1 – 672 с., ил.
2. У.Орвис. Visual Basic for application.-М. Бином 1995.
Приложение А. Программный код
Public N_auto, M_auto, M_benz, q, B, E As String
Public O_prob, Potr, Zena, O_stoim As Single
'Процедура по нажатию кнопки "подсчитать"
Private Sub CommandButton1_Click()
N_auto = UserForm1.TextBox1
If N_auto = "" Then
B = MsgBox("Введите номер автомобиля", vbCritical, "")
'Фокусирование на поле ввода
UserForm1.TextBox1.SetFocus
GoTo s
End If
M_auto = UserForm1.TextBox2
If M_auto = "" Then
B = MsgBox("Введите марку автомобиля", vbCritical, "")
UserForm1.TextBox2.SetFocus
GoTo s
End If
M_benz = UserForm1.TextBox3
If M_benz = "" Then
B = MsgBox("Введите марку бензина", vbCritical, "")
UserForm1.TextBox3.SetFocus
GoTo s
End If
O_prob = UserForm1.TextBox4
If O_prob = "" Then
B = MsgBox("Введите общий пробег", vbCritical, "")
UserForm1.TextBox4.SetFocus
GoTo s
End If
O_prob = ""
'Сообщение об ошибке при вводе нечисловых данных
On Error Resume Next
O_prob = CDbl(UserForm1.TextBox4)
If O_prob = "" Then
B = MsgBox("Введите число!!!", vbCritical, "")
UserForm1.TextBox4.SetFocus
GoTo s
End If
Potr = UserForm1.TextBox4
If Potr = "" Then
B = MsgBox("Введите потребление л/100", vbCritical, "")
UserForm1.TextBox5.SetFocus
GoTo s
End If
Potr = ""
On Error Resume Next
Potr = CDbl(UserForm1.TextBox5)
If Potr = "" Then
B = MsgBox("Введите число!!!", vbCritical, "")
UserForm1.TextBox5.SetFocus
GoTo s
End If
Zena = UserForm1.TextBox6
If Potr = "" Then
B = MsgBox("Введите цену 1 л. бензина", vbCritical, "")
UserForm1.TextBox6.SetFocus
GoTo s
End If
Zena = ""
On Error Resume Next
Zena = CDbl(UserForm1.TextBox6)
If Potr = "" Then
B = MsgBox("Введите число!!!", vbCritical, "")
UserForm1.TextBox6.SetFocus
GoTo s
End If
'Расчёт общей стоимости
O_stoim = Potr / 100 * Zena * O_prob
'Поиск пустой строки
i = 3
While (ActiveSheet.Cells(i, 1) <> "")
E = ActiveSheet.Cells(i, 1)
i = i + 1
E = ""
Wend
'Заполнение ячеек таблицы данными
If E = "" Then
ActiveSheet.Cells(i, 1) = CStr(N_auto)
ActiveSheet.Cells(i, 2) = CStr(M_auto)
ActiveSheet.Cells(i, 3) = CStr(M_benz)
ActiveSheet.Cells(i, 4) = CStr(O_prob)
ActiveSheet.Cells(i, 5) = CStr(Potr)
ActiveSheet.Cells(i, 6) = CStr(Zena)
ActiveSheet.Cells(i, 7) = CStr(O_stoim)
End If
If N_auto = E Then
B = MsgBox("Такой номер автомобиля есть в базе данных", vbCritical, "")
UserForm1.TextBox1.SetFocus
GoTo s
End If
B = MsgBox("Запись внесена", vbInformation, "")
For rwIndex = 3 To i - 1
For colIndex = 1 To 6
Next colIndex
Next rwIndex
'Сортировка по полю "Марка автомобиля"
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
'Заполнение формы пустыми значениями
UserForm1.TextBox1.Text = ""
UserForm1.TextBox2.Text = ""
UserForm1.TextBox3.Text = ""
UserForm1.TextBox4.Text = ""
UserForm1.TextBox5.Text = ""
UserForm1.TextBox6.Text = ""
UserForm1.TextBox1.SetFocus
s:
End Sub
'Процедура выхода
Private Sub CommandButton2_Click()
Unload Me
End Sub
'Информация о разработчике
Private Sub CommandButton3_Click()
Load UserForm2
UserForm1.Hide
UserForm2.Show
End Sub
'Процедура инициализации формы
Private Sub UserForm_Initialize()
UserForm1.Caption = "Главная форма"
UserForm1.TextBox1.Text = ""
UserForm1.TextBox2.Text = ""
UserForm1.TextBox3.Text = ""
UserForm1.TextBox4.Text = ""
UserForm1.TextBox5.Text = ""
UserForm1.TextBox6.Text = ""
UserForm1.TextBox1.SetFocus
'Выбор ячеек шапки
Range("A1:G1").Select
'объединение ячеек
With Selection.WrapText = False
Selection.Orientation = 0
Selection.AddIndent = True
Selection.IndentLevel = 0
Selection.ShrinkToFit = True
Selection.ReadingOrder = xlContext
Selection.MergeCells = True
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
End With
ActiveCell.FormulaR1C1 = "Индивидуальное задание"
' установка шрифта
With Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Font.Strikethrough = False
Selection.Font.Superscript = False
Selection.Font.Subscript = False
Selection.Font.OutlineFont = False
Selection.Font.Shadow = False
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = xlAutomatic
Selection.Font.Bold = True
End With
Range("A2").Select
'центровка записи
ActiveCell.FormulaR1C1 = "Номер автомобиля"
With Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.WrapText = True
Selection.Orientation = 0
Selection.AddIndent = True
Selection.IndentLevel = 0
Selection.ShrinkToFit = True
Selection.ReadingOrder = xlContext
Selection.MergeCells = True
Selection.HorizontalAlignment = xlCenter
End With
Columns("A:A").ColumnWidth = 15
Rows("2:2").EntireRow.AutoFit
Columns("A:A").EntireColumn.AutoFit
'установка шрифта
With Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Font.Strikethrough = False
Selection.Font.Superscript = False
Selection.Font.Subscript = False
Selection.Font.OutlineFont = False
Selection.Font.Shadow = False
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = xlAutomatic
Selection.Font.Bold = True
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("B2").Select
ActiveCell.FormulaR1C1 = "Марка автомобиля"
'центровка записи
With Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.WrapText = True
Selection.Orientation = 0
Selection.AddIndent = True
Selection.IndentLevel = 0
Selection.ShrinkToFit = True
Selection.ReadingOrder = xlContext
Selection.MergeCells = False
Selection.HorizontalAlignment = xlCenter
End With
Columns("B:B").ColumnWidth = 15
Rows("2:2").EntireRow.AutoFit
Columns("B:B").EntireColumn.AutoFit
'установка шрифта
With Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Font.Strikethrough = False
Selection.Font.Superscript = False
Selection.Font.Subscript = False
Selection.Font.OutlineFont = False
Selection.Font.Shadow = False
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = xlAutomatic
Selection.Font.Bold = True
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C2").Select
ActiveCell.FormulaR1C1 = "Марка бензина"
'центровка записи
With Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.WrapText = True
Selection.Orientation = 0
Selection.AddIndent = True
Selection.IndentLevel = 0
Selection.ShrinkToFit = True
Selection.ReadingOrder = xlContext
Selection.MergeCells = False
Selection.HorizontalAlignment = xlCenter
End With
Columns("C:C").ColumnWidth = 9
Rows("2:2").EntireRow.AutoFit
Columns("C:C").EntireColumn.AutoFit
'установка шрифта
With Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Font.Strikethrough = False
Selection.Font.Superscript = False
Selection.Font.Subscript = False
Selection.Font.OutlineFont = False
Selection.Font.Shadow = False
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = xlAutomatic
Selection.Font.Bold = True
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("D2").Select
ActiveCell.FormulaR1C1 = "Общий пробег"
'центровка записи
With Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.WrapText = True
Selection.Orientation = 0
Selection.AddIndent = True
Selection.IndentLevel = 0
Selection.ShrinkToFit = True
Selection.ReadingOrder = xlContext
Selection.MergeCells = False
Selection.HorizontalAlignment = xlCenter
End With
Columns("D:D").ColumnWidth = 7
Rows("2:2").EntireRow.AutoFit
Columns("D:D").EntireColumn.AutoFit
'установка шрифта
With Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Font.Strikethrough = False
Selection.Font.Superscript = False
Selection.Font.Subscript = False
Selection.Font.OutlineFont = False
Selection.Font.Shadow = False
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = xlAutomatic
Selection.Font.Bold = True
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = "Потребление л/100"
'центровка записи
With Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.WrapText = True
Selection.Orientation = 0
Selection.AddIndent = True
Selection.IndentLevel = 0
Selection.ShrinkToFit = True
Selection.ReadingOrder = xlContext
Selection.MergeCells = False
Selection.HorizontalAlignment = xlCenter
End With
Columns("E:E").ColumnWidth = 15
Rows("2:2").EntireRow.AutoFit
Columns("E:E").EntireColumn.AutoFit
'установка шрифта
With Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Font.Strikethrough = False
Selection.Font.Superscript = False
Selection.Font.Subscript = False
Selection.Font.OutlineFont = False
Selection.Font.Shadow = False
Selection.Font.Underline = xlUnderlineStyleNone
Selection.Font.ColorIndex = xlAutomatic
Selection.Font.Bold = True
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin