Смекни!
smekni.com

Основы программирования на VBA модель объектов Exel (стр. 2 из 3)


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