Private Sub Cmd_OK_Click() 'Кнопка ОК (перенос данных с формы на лист1)
Application.ScreenUpdating = False 'выключили обновление экрана
Dim X As Control
For Each X In Форма.Controls 'Проверяем - все ли обязательные поля заполнены?
If TypeOf X Is MSForms.TextBox Or TypeOf X Is MSForms.ComboBox Then
If X.Visible = True Then
If X.Value = "" Then
MsgBox "Все обязательные поля должны быть заполнены.", 48, "Ошибка!"
X.SetFocus
Exit Sub
End If
End If
End If
Next
With Sheets("спецификации")
Lrow = .Cells(Rows.Count, 1).End(xlUp).Row 'по 1 столбцу
If Lrow = 5 Then 'первое заполнение
LastRow = Lrow
Else
LastRow = Lrow + 2
End If
'заполняем шапку
Cells(LastRow + 1, 1).Offset(-1, 0) = "Наименование"
Cells(LastRow + 1, 2).Offset(-1, 0) = "Размер"
Cells(LastRow + 1, 3).Offset(-1, 0) = "Количество"
If SpinButton1.Value = 1 Then
If MsgBox("Произвести ввод данных?", vbYesNo, "Подтверждение") = vbNo Then Exit Sub
' добавляем позицию1
Cells(LastRow + 1, 1).Offset(-2, 0) = Me.ComboBox9.Value 'номер авто
Cells(LastRow + 1, 1) = Me.ComboBox1.Value ' наименование
Cells(LastRow + 1, 2) = Me.TextBox3 'размер
Cells(LastRow + 1, 3) = CDbl(Me.TextBox6) 'к-во
ElseIf SpinButton1.Value = 2 Then
' добавляем 1 позицию
Cells(LastRow + 1, 1).Offset(-2, 0) = Me.ComboBox9.Value
Cells(LastRow + 1, 1) = Me.ComboBox1.Value
Cells(LastRow + 1, 2) = Me.TextBox3
Cells(LastRow + 1, 3) = CDbl(Me.TextBox6)
' добавляем 2 позицию
Cells(LastRow + 2, 1) = Me.ComboBox2.Value
Cells(LastRow + 2, 2) = Me.TextBox4
Cells(LastRow + 2, 3) = CDbl(Me.TextBox7)
ElseIf SpinButton1.Value = 3 Then
' ' добавляем 1 позицию+2-ю и 3 позицию
Cells(LastRow + 1, 1).Offset(-2, 0) = Me.ComboBox9.Value
Cells(LastRow + 1, 1) = Me.ComboBox1.Value
Cells(LastRow + 1, 2) = Me.TextBox3
Cells(LastRow + 1, 3) = CDbl(Me.TextBox6)
Cells(LastRow + 2, 1) = Me.ComboBox2.Value
Cells(LastRow + 2, 2) = Me.TextBox4
Cells(LastRow + 2, 3) = CDbl(Me.TextBox7)
Cells(LastRow + 3, 1) = Me.ComboBox3.Value
Cells(LastRow + 3, 2) = Me.TextBox5
Cells(LastRow + 3, 3) = CDbl(Me.TextBox8)
End If
End With
If Lrow = 5 Then 'первое заполнение
NextRow = Sheets("спецификации").Cells(LastRow, 1).End(xlDown).Row + 1
Else
NextRow = Sheets("спецификации").Cells(Lrow, 1).End(xlDown).Row + 2 + SpinButton1.Value
End If
'Запись данных в строку "Всего"
Cells(NextRow, 1) = "Всего"
Cells(NextRow, 3) = WorksheetFunction.Sum(Range(Cells(NextRow - SpinButton1.Value, 3), Cells(NextRow - 1, 3)))
' форматирование общее
Range(Cells(4, 1), Cells(LastRow + 1, 1)).Borders.LineStyle = xlContinuous
Range(Cells(5, 1), Cells(LastRow + 1, 3)).Borders.LineStyle = xlContinuous
Range(Cells(5, 1), Cells(LastRow + 1, 3)).HorizontalAlignment = xlCenter
Range(Cells(5, 1), Cells(LastRow + 1, 3)).VerticalAlignment = xlCenter
' форматирование для строки Всего
Range(Cells(NextRow, 1), Cells(NextRow, 3)).Borders.LineStyle = xlContinuous 'Сделали обрамление ячеек
Range(Cells(NextRow, 1), Cells(NextRow, 3)).HorizontalAlignment = xlCenter 'выравнивание
Range(Cells(NextRow, 1), Cells(NextRow, 3)).VerticalAlignment = xlCenter
'.Borders.LineStyle = xlNone 'нет границы
Dim r As Range, a As Range
On Error Resume Next
Set r = Range(Cells(4, 1), Cells(LastRow + 1, 1)).SpecialCells(4)
For Each a In r.Areas
a.Resize(, 3).Borders.LineStyle = xlNone
a.Resize(, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
a.Resize(, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
On Error GoTo 0
Application.ScreenUpdating = True 'включили обновление экрана
'очистка полей формы для последующих записей
Dim oControl As Control
For Each oControl In Форма.Controls
If TypeOf oControl Is MSForms.TextBox Or TypeOf oControl Is MSForms.ComboBox Then oControl.Value = ""
Next oControl
Select Case MsgBox(" Вы действительно хотите создать следующую спецификацию", 36, "Подтверждение создания следующей спецификации")
Case 6 ' Да
Case 7 ' Нет
End Select
With SpinButton1
.Value = 1
TextBox2.Text = .Value ' инициализация TextBox
End With
End Sub |
