|
p align="left">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 .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("F2").Select ActiveCell.FormulaR1C1 = "Цена 1 л бензина" 'центровка записи 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("F:F").ColumnWidth = 15 Rows("2:2").EntireRow.AutoFit Columns("F:F").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("G2").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("G:G").ColumnWidth = 15 Rows("2:2").EntireRow.AutoFit Columns("G:G").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 End Sub Приложение Б. Экранная копия тестового примера
Страницы: 1, 2
| 
