Задание 3. Добавление данных в таблицу Excel
Задание 1. Добавление данных в таблицу «Прейскурант»
Создайте для примера таблицу следующего вида:
Затем перейдите в VBA (Alt+F11) и постройте форму с элементами управления следующего вида:
В этой форме использованы три элемента Label, свойства Caption которых изменены соответственно на «Код товара», «Наименование товара» и «Цена за кг». Три элемента TextBox, которые будут использоваться для ввода новых данных и две кнопки CommandButton. Сделаем двойной щелчок на кнопке «Добавить» - попадаем в программу, в которой начальная и конечная процедура уже созданы. Добавляем следующий программный код:
Private Sub CommandButton1_Click()
‘ переменные «текущая» и «следующая» вводятся для обозначения строк таблицы и имеют тип «Объектные»
Dim текущая As Object
Dim следующая As Object
‘ выполняем проверку: если не все поля формы заполнены новыми данными, должно выйти сообщение для пользователя и ввод данных завершается:
If TextBox1 = " " Or TextBox2 = " " Or TextBox3 = " " Then
MsgBox ("Введены не все данные")
Exit Sub
End If
' определяет где последняя непустая строка таблицы
ActiveWorkbook.Sheets("Лист1").Select
Set текущая = ActiveSheet.Range("A2")
‘цикл «до тех пор пока» - переменная соответствует выбранному типу
Do While Not IsEmpty(текущая)
Set следующая = текущая.Offset(1, 0)
Set текущая = следующая
Loop
'ввод данных из полей формы в первую пустую строку таблицы
текущая.Value = TextBox1.Text
текущая.Offset(0, 1).Value = TextBox2.Text
текущая.Offset(0, 2).Value = TextBox3.Text
'очистка полей формы
TextBox1.Text = " "
TextBox2.Text = " "
TextBox3.Text = " "
End Sub
К кнопке «Отменить» добавляем программный код:
Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub
Кроме этого для текстовых полей выполним проверку. Для текстового поля, в которое вводится наименование товара выполняем проверку, чтобы вводимые данные были только текстовые (чтобы нельзя было вводить числа):
Private Sub TextBox2_Change()
If IsNumeric(TextBox2.Text) And Len(TextBox2) <> 0 Then
MsgBox "Вводить надо текстовые данные!", vbOKOnly + vbInformation
TextBox2.Value = " "
TextBox2.SetFocus
End If
End Sub
Для текстового поля, в которое вводится цена товара, выполняем проверку, чтобы вводимые данные были только числовые (чтобы нельзя было вводить текст):
Private Sub TextBox3_Change()
If TextBox3.Value < 0 Then
MsgBox "Числа не должны быть отрицательные!", vbOKOnly + vbInformation
TextBox3.SetFocus
End If
If Not IsNumeric(TextBox3.Text) And Len(TextBox3) <> 0 Then
MsgBox "Вводить надо числовые данные!", vbOKOnly + vbInformation
TextBox3.Value = " "
TextBox3.SetFocus
End If
End Sub
Задание 4 Добавление данных на лист «Реализация товаров» Задание 5. Добавление и удаление данных (с применением вкладок)
Создайте два рабочих листа, назовите их «Прейскурант» и «Реализация»
Вид листа «Прейскурант»:
Вид листа «Реализация»:
Создайте 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