3.5. Примеры создания базы данных.
3.5.1. База данных гостиницы.
Пример
программы, создающей простую базу данных
регистрации клиентов отеля на рабочем
листе База.
База данных будет заполняться программой. Программе не требуются названия полей, но для облегчения ориентации пользователя в первой строке рабочего листа "База" введем их названия.
Выделите вторую строку рабочего листа "База" и выполните команду
ОкноЗакрепить области. Теперь заголовок будет присутствовать на экране постоянно при просмотре любых записей базы. Нажмем кнопку "Ввод данных", с помощью диалогового окна "Регистрация" будет заполняться база данных.
Диалоговое окно "Регистрация туристов" создается на листе диалога "Регистрация" средствами панели инструментов "Формы".
Для работы с раскрывающимся списком на вспомогательном рабочем листе "Переменные" в диапазон А1:А3 с именем "Типы_номеров" вводим последовательно типы номеров: люкс, одноместный, двухместный.
Ячейке А15 присвоим имя "номер", а ячейке А14 - имя "Тип_номера". Кроме того, в ячейку А14 введем формулу =ИНДЕКС(Типы_номеров;номер;1)
Затем в диалоговом окне "Регистрация туристов" щелкнем правой кнопкой мыши по объекту "Поле со списком", с помощью контекстного меню вызовем диалоговое окно "Форматирование объекта". В поле "Формировать список по диапазону" введем имя диапазона "Типы_номеров"; в поле "помещать результат в ячейку" введем имя ячейки "Номер".
Кнопке "Ввод данных" рабочего листа "База" назначим процедуру EnterData. Со счетчиком диалогового окна "Регистрация" свяжем процедуру DoSpinner, выводящую в третье поле ввода текущее значение счетчика, а с третьим полем ввода - процедуру BackSpinner для синхронизации значения счетчика с содержимым поля ввода.
Sub EnterData()
Dim Фамилия, Имя, Срок, Оплачено, Паспорт As String
Dim Выб_номер, Пол As String
Dim DboxOk As Boolean
Dim row As Integer
Start:
With DialogSheets("Регистрация")
.EditBoxes(1).Text = ""
.EditBoxes(2).Text = ""
.EditBoxes(3).Text = ""
.CheckBoxes(1).Value = xlOff
.CheckBoxes(2).Value = xlOff
.Spinners(1).Min = 1
.Spinners(1).Max = 100
End With
DboxOk = DialogSheets("Регистрация").Show
If Not DboxOk Then Exit Sub
row = Application.CountA(Sheets("база").Range("c:c")) + 1
With DialogSheets("Регистрация")
Фамилия = .EditBoxes(1).Text
Имя = .EditBoxes(2).Text
Срок = .EditBoxes(3).Text
If .OptionButtons(1) = xlOn Then Пол = "муж"
If .OptionButtons(2) = xlOn Then Пол = "жен"
If .CheckBoxes(1) = xlOn Then
Оплачено = "да"
Else
Оплачено = "нет"
End If
If .CheckBoxes(2) = xlOn Then
Паспорт = "да"
Else
Паспорт = "нет"
End If
End With
Выб_номер = Worksheets("Переменные").Range("Тип_номера")
With Sheets("база")
.Cells(row, 1).Value = Фамилия
.Cells(row, 2).Value = Имя
.Cells(row, 3).Value = Пол
.Cells(row, 4).Value = Выб_номер
.Cells(row, 5).Value = Оплачено
.Cells(row, 6).Value = Паспорт
.Cells(row, 7).Value = Срок
End With
GoTo Start
End Sub
Sub DoSpinner()
With ActiveDialog
.EditBoxes(3).Text = CStr(.Spinners(1).Value)
End With
End Sub
Sub BackSpinner()
With ActiveDialog
.Spinners(1).Value = CInt(.EditBoxes(3).Text)
End With
End Sub
Sub poisk()
Dim Фамилия, ff, Имя, Срок, Оплачено, Паспорт As String
Dim Выб_номер, Пол As String
Dim DboxOk As Boolean
Dim row As Integer
Dim measure As Long
Dim найдено As Boolean
Range("поиск").Value = InputBox("введите Фамилию")
поиск = Range("поиск").Value
найдено = False
Set область = Sheets("база").Cells(1, 1).CurrentRegion
количество = область.Rows.Count
num = 2
'MsgBox (Str(num))
With Sheets("база")
While Not найдено And num <= количество
'MsgBox (Cells(num, 1))
If .Cells(num, 1) = поиск Then
найдено = True
row = num
End If
num = num + 1
Wend
'MsgBox CStr(найдено)
If найдено Then
MsgBox " найдено"
Else
MsgBox " НЕ найдено"
Exit Sub
End If
End With
'Sheets("база").Cells(Row, 1).EntireRow.Show
With Sheets("база")
Фамилия = .Cells(row, 1).Value
Имя = .Cells(row, 2).Value
Пол = .Cells(row, 3).Value
Выб_номер = .Cells(row, 4).Value
Оплачено = .Cells(row, 5).Value
Паспорт = .Cells(row, 6).Value
Срок = .Cells(row, 7).Value
End With
If Выб_номер = "Люкс" Then Worksheets("Переменные").Range("Номер") = 1
If Выб_номер = "Одноместный" Then Worksheets("Переменные").Range("Номер") = 2
If Выб_номер = "Двухместный" Then Worksheets("Переменные").Range("Номер") = 3
nn = Worksheets("Переменные").Range("Номер")
MsgBox (Выб_номер)
MsgBox (CStr(nn))
With DialogSheets("регистрация")
.EditBoxes(1).Text = Фамилия
.EditBoxes(2).Text = Имя
.EditBoxes(3).Text = Срок
If Пол = "муж" Then .OptionButtons(1) = xlOn
If Пол = "жен" Then .OptionButtons(2) = xlOn
If Оплачено = "да" Then
.CheckBoxes(1) = xlOn
Else
.CheckBoxes(1) = xlOff
End If
If Паспорт = "да" Then
.CheckBoxes(2) = xlOn
Else
.CheckBoxes(2) = xlOff
End If
.Spinners(1).Min = 1
.Spinners(1).Value = CInt(.EditBoxes(3).Text)
.DropDowns(1).Value = nn
.Spinners(1).Max = 100
End With
DboxOk = DialogSheets("регистрация").Show
If Not DboxOk Then Exit Sub
'Range("h2").Value = InputBox("Удалить запись?(да)")
' MsgBox CStr(Row)
With DialogSheets("регистрация")
Фамилия = .EditBoxes(1).Text
Имя = .EditBoxes(2).Text
Срок = .EditBoxes(3).Text
If .OptionButtons(1) = xlOn Then Пол = "муж"
If .OptionButtons(2) = xlOn Then Пол = "жен"
If .CheckBoxes(1) = xlOn Then
Оплачено = "да"
Else
Оплачено = "нет"
End If
If .CheckBoxes(2) = xlOn Then
Паспорт = "да"
Else
Паспорт = "нет"
End If
End With
Выб_номер = Worksheets("Переменные").Range("Тип_номера")
'If Range("h2").Value = "да" Then
'ff = "": Имя = ""
'End If
' MsgBox (ff)
With Sheets("база")
.Cells(row, 1).Value = Фамилия
.Cells(row, 2).Value = Имя
.Cells(row, 3).Value = Пол
.Cells(row, 4).Value = Выб_номер
.Cells(row, 5).Value = Оплачено
.Cells(row, 6).Value = Паспорт
.Cells(row, 7).Value = Срок
End With
With DialogSheets("регистрация")
.EditBoxes(1).Text = Фамилия
.EditBoxes(2).Text = Имя
.EditBoxes(3).Text = Срок
If Пол = "муж" Then .OptionButtons(1) = xlOn
If Пол = "жен" Then .OptionButtons(2) = xlOn
If Оплачено = "да" Then
.CheckBoxes(1) = xlOn
Else
.CheckBoxes(1) = xlOff
End If
If Паспорт = "да" Then
.CheckBoxes(2) = xlOn
Else
.CheckBoxes(2) = xlOff
End If
End With
DboxOk = DialogSheets("регистрация").Show
If Not DboxOk Then Exit Sub
End Sub
Sub delet()
Dim найдено As Boolean
Range("поиск").Value = InputBox("введите Фамилию")
поиск = Range("поиск").Value
найдено = False
Set область = Sheets("база").Cells(1, 1).CurrentRegion
количество = область.Rows.Count
num = 2
With Sheets("база")
While Not найдено And num <= количество
If .Cells(num, 1) = поиск Then
найдено = True
row = num
End If
num = num + 1
Wend
If найдено Then
MsgBox " найдено"
Else
MsgBox " НЕ найдено"
Exit Sub
End If
End With
Worksheets("база").Rows(row).Clear
сортировка
End Sub
Sub сортировка()
количество = Application.CountA(Sheets("база").Range("c:c")) + 1
Range(Cells(2, 1), Cells(количество, 7)).Select
Selection.Sort key1:=Range("A2")
', order1:=xlAscending, Header:=xlGuess, OrderGustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Дадим необходимые пояснения к приведенной выше программе. CheckBoxes, EditBoxes, Spinners являются объектами управления : флажок, поле и счетчик. Другими наборами объектов управления являются
ListBoxes список;
DropDowns раскрывающийся список;
ScrollBars полоса прокрутки;
Labels надпись.
Свойства Min,Max объекта счетчик определяют минимальное и максимальное значения счетчика с указанным номером, т.е. конструкция DialogSheets("Регистрация").Spinners(1).Min=1 задает минимальное значение первого счетчика =1.
Конструкция DialogSheets("Регистрация").EditBoxes(1).Text="" очищает поле ввода с номером1.
Оператор With-End With используется для удобства при работе с несколькими свойствами или методами одного и того же объекта.
В переменную Row вводится номер первой пустой строки на рабочем листе "База".
В конструкции
DbOxOk=DialogSheets("Регистрация").Show
If not DbOxOk then exit Sub
свойство Show возвращает true, если диалоговое окно открыто, и False - в противном случае. Таким образом данная конструкция при нажатии в диалоговом окне кнопки "отмена" присваивает переменной DbOxOk значение False, что приводит к завершению работы процедуры EnterData. Если кнопка "Отмена" не нажата, то переменной DbOxOk присваивается значение True и процедура EnterData продолжает работу по заполнению базы данных.
Другой способ выполнения этой же операции - без использования дополнительной переменной и оператора безусловного перехода:
Do While DialogSheets("Регистрация").Show
Блок операторов
Loop
Метод Show позволяет отобразить диалоговое окно. Например, диалоговое окно "Регистрация" может быть отображено на экране с помощью команды Sheets("Регистрация").Show
Диалоговое окно будет отображаться на экране до тех пор, пока не будет нажата кнопка "Ok" или "Отмена".
Команда Sheets("Регистрация").Hide закроет ранее открытое диалоговое окно.
Существуют различие между методом Show , который отображает диалоговое окно и методом Activate, который активизирует лист диалогового окна, т.е. возвращает в режим конструирования.
Конструкция If OptionButtons(1)=xlon then пол="муж" присваивает переменной пол значение "муж", если выбрали первый переключатель.
При обращении из программы к элементам управления в диалоговом окне важно знать порядок их расположения. Порядок расположения элементов - это порядок их обхода с помощью клавиши <Tab>. Изначально порядок расположения управляющих элементов соответствует порядку их создания. Затем его можно изменять с помощью диалогового окна "Последовательность перехода", вызываемого командой Сервис Последовательность перехода, не затрагивая при этом сами элементы. Порядковый номер элемента управления при его выделении выводится в поле имени.
Алгоритм поиска клиента.
Ввод фамилии
Логическая переменная = False
Определить область поиска
Set область=Sheets("база").Cells(1,1).CurrentRegion
Количество=область.Rows.Count
Num=2
Not найдено and numколич-во
да
нет
Сells(num,1)=поиск
да
нет
Найдено=true
Row=num
Num=num+1
На листе "База" присвоить значения переменным
Фамилия= .Cells(Row,1).Value
Имя= .Cells(Row,2).Value
Пол= .Cells(Row,3).Value
Выб_номер= .Cells(Row,4).Value
Оплачено= .Cells(Row,5).Value
Паспорт= .Cells(Row,6).Value
Срок= .Cells(Row,7).Value
Отмечаем все изменения на вспомогательном листе with WorkSheets("Переменные")
If Выб_номер = "люкс" then .Range("номер")=1
If Выб_номер = "Одноместный" then .Range("номер")=2
If Выб_номер = "Двухместный" then .Range("номер")=3
Nn = .Range("номер")
End with
Отобразим информацию в диалоговом окне
.EditBoxes(1).text = фамилия
.EditBoxes(2).text = имя
.EditBoxes(3).text = срок
if пол = "муж" then .OptionButtons(1) = xlOn
if пол = "жен" then .OptionButtons(1) = xlOff
If Оплачено = "да" Then
.CheckBoxes(1) = xlOn
Else
.CheckBoxes(1) = xlOff
End If
If Паспорт = "да" Then
.CheckBoxes(2) = xlOn
Else
.CheckBoxes(2) = xlOff
End If
.Spinners(1).min=1
.Spinners(1).Value =Cint(.EditBoxes(3).Text)
.DropDowns(1).Value = nn
.Spinners(1).Max = 100
Активизировать окно "Регистрация"
В окне Регистрация отображаем все возможные изменения
Отображаем все возможные изменения на листе База
.EditBoxes(1).text=фамилия
и.т.д.
конец
Процедура удаления
Найти нужную фамилию
WorkSheets("База").Rows(Row).Clear
Процедура сортировки
Количество = Application.CountA( Sheets("База").Range("c:c")) +1
Range ( Cells(2,1), Cells(Количество,7)).Select
Selection. SortKey:=Range("A2")