
Добавление и удаление данных - еще одна полезная возможность, сделать работу человека проще. Реализация подобной функции позволит безошибочно добавлять новые данные, не забыв про какой либо атрибут, т.е. добавить в таблицу строчку (например) с новым клиентом, и исключить его добавление не указав номер телефона.
Создайте два рабочих листа, назовите их «Прейскурант» и «Реализация»
Вид листа «Прейскурант»:
Вид листа «Реализация»:
Создайте UserForm следующего вида (при создании используется элемент управления Page – что позволяет создать две вкладки «Добавить» и «Удалить»).
Вид UserForm для вкладки «Добавить». Обратите внимание, что снизу под вводом цены расположена надпись (это Label4), при подведении мышки к кнопкам «Добавить» или «Отмена» в этой надписи будет появляться информация!
Программные коды:
Для кнопки «Добавить»:
Private Sub CommandButton1_Click()
Dim Y As Byte
If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then
Y = MsgBox("Добавление этого товара невозможно, т.к. не введены все критерии", vbOKCancel, "Товар")
If h = vbCancel Then GoTo e Else GoTo 12
End If
Dim name As String, simvol As String
Dim pr As Object, X As Object
Dim Название As String, Символ As String
Dim Цена As Integer
‘проверка не повторяется ли код:
ActiveWorkbook.Sheets("Прейскурант").Activate
simvol = TextBox1
Set pr = ActiveSheet.Range("a1")
Do While Not IsEmpty(pr)
Set X = pr.Offset(1, 0)
If pr = simvol Then
Y = MsgBox("Добавление невозможно, т.к. введеный код уже зарегистрирован", vbOKCancel, "Код")
If Y = vbCancel Then GoTo e Else GoTo 12
End If
Set pr = X
Loop
‘ проверка не вводится ли повторяющееся наименование товара:
ActiveWorkbook.Sheets("Прейскурант").Activate
name = TextBox2
Set pr = ActiveSheet.Range("b2")
Do While Not IsEmpty(pr)
Set X = pr.Offset(1, 0)
If pr = name Then
Y = MsgBox("Такой товар уже есть в списке, внести его еще под другим кодом?", vbYesNo + vbQuestion, "Товар")
If Y = vbYes Or Y = vbNo Then GoTo 5 Else GoTo 12
End If
Set pr = X
Loop
5 Символ = TextBox1
Название = TextBox2
Цена = TextBox3
ActiveWorkbook.Sheets("Прейскурант").Activate
'поиск пустой строки, в которую будут добавлены данные
Range("A3").Select
Selection.EntireRow.Insert
Set pr = ActiveSheet.Range("A2")
Do While Not IsEmpty(pr)
Set X = pr.Offset(1, 0)
Set pr = X
Loop
pr = Символ
pr.Offset(0, 1) = Название
pr.Offset(0, 2) = Цена
Set pr = Nothing
Set X = Nothing
'сортировка
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
12 UserForm1.Hide
e: End Sub
Программные коды для «всплывающей» надписи:
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label4.Caption = "Добавить в список набранный товар"
End Sub
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label4.Caption = "Сброс набранной информации"
End Sub
Программный код для кнопки «Сброс»:
Private Sub CommandButton2_Click()
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
End Sub
Проверка для ввода только числовых данных:
' Обработка нажатия клавиш - не позволяет вводить другие символы, кроме цифр
Private Sub textbox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
Beep
KeyAscii = 0
End If
End Sub
При удалении данных будет автоматически выходить название товара. Удаление будет производиться сразу в двух таблицах: на листе «прейскурант» и на листе «Реализация».
UserForm (вкладка «Удалить») выгладит следующим образом:
Программный код для кнопки «Удалить»:
Private Sub CommandButton3_Click()
Dim pr As Object, X As Object
Dim name As String
Dim h As Byte
Dim Y As Byte
h = MsgBox("Вы действительно хотите удалить этот товар?", vbYesNo + vbQuestion, "Удаление")
If h = vbYes Then Else GoTo e
name = ComboBox1
If ComboBox1 = "" Then
Y = MsgBox("Удаление невозможно, т.к. не выделен объект", vbYes + vbQuestion, "Удаление")
If Y = vbYes Then GoTo 12 Else GoTo e
End If
ActiveWorkbook.Sheets("Реализация").Activate
Set pr = ActiveSheet.Range("b2")
Do While Not IsEmpty(pr)
Set X = pr.Offset(1, 0)
If pr = name Then
pr.Select
Selection.EntireRow.Delete
End If
Set pr = X
Loop
ActiveWorkbook.Sheets("Прейскурант").Activate
Set pr = ActiveSheet.Range("a2")
Do While Not IsEmpty(pr)
Set X = pr.Offset(1, 0)
If pr = name Then
pr.Select
Selection.EntireRow.Delete
End If
Set pr = X
Loop
12 ComboBox1 = ""
Label7 = ""
UserForm1.Hide
e: End Sub
программный код для активации формы:
Private Sub UserForm_activate()
Dim pr As Object, X As Object
UserForm1.ComboBox1.Clear
ActiveWorkbook.Sheets("Прейскурант").Select
Set pr = ActiveSheet.Range("a2")
Do While Not IsEmpty(pr)
Set X = pr.Offset(1, 0)
ComboBox1.AddItem pr
Set pr = X
Loop
End Sub