Тема: Еще раз о составлении базы данных

Цель урока

В разрабатываемом в данном уроке приложении создается база данных туристической фирмы "С нами не соскучишься" на рабочем листе с пользовательским интерфейсом и средствами анализа, поиска и обработки информации, хранимой в базе данных. Предусмотрена архивация и удаление выбранных записей базы данных.
В процессе разработки данного приложения вы на практике освоите:

  • Конструирование пользовательского интерфейса
  • Создание приложения, работающего с несколькими диалоговыми окнами
  • Поиск информации в базе данных на рабочем листе
  • Редактирование записей в базе данных на рабочем листе
  • Удаление ненужных записей из базы данных на рабочем листе
  • Архивацию данных на рабочем листе
  • Программирование фильтрации данных
  • Программирование сортировки данных
  • Программирование создания сводных таблиц
  • Построение диаграмм по сводным таблицам
  • Добавление пользователем новых элементов в поле со списком во время выполнения программы

Практика
В этом уроке строится приложение с пользовательским интерфейсом по заполнению и обработке базы данных туристической фирмы "С нами не соскучишься". База данных состоит из двух рабочих листов: БазаДанных (рис. У 10.1) и Архив ( 2). Кроме того, при построении сводной таблицы по базе данных создается рабочий лист своднаяТаблица.
После загрузки программа сама будет создавать свой интерфейс, отображать название окна приложения и если на рабочих листах нет заголовков полей, то создавать их. Интерфейс программы будет состоять из нескольких диалоговых окон.

Диалоговое окно

Назначение

Форма

Регистрация туристов фирмы "С нами не соскучишься" ( 3)

Для заполнения рабочего листа БазаДан-ных

UserForm1

Поиск ( 4)

Производит поиск клиента по фамилии. В фамилии клиента допустимо использовать символ <*> вместо группы любых символов, символ <?> вместо любого одного символа. В результате поиска, в случае отсутствия подходящих клиентов выдается соответствующее сообщение. Если подходящие клиенты найдены, в раскрывающемся списке выводится список их фамилий и имен. Выбрав требуемого клиента и нажав кнопку Редактировать, пользователь переходит к этапу редактирования информации о клиенте

UserForm3

Перерегистрация туристов фирмы "С нами не соскучишься" (рис. У1 0.5)

В него загружается информация о найденном клиенте. Допустимо любое редактирование информации с последующей заменой старой информации о клиенте на новую в базе данных. Также возможна запись информации в архив и ее удаление из базы данных.

UserForm2

Фильтрация ( 6)

В зависимости от выбранного переключателя отображает только оплаченные или только не оплаченные путевки.

UserForm4

 

Перейдем к рассмотрению кнопок панели инструментов пользовательского меню.

Кнопка

Назначение

Регистрация

Активизирует диалоговое окно Регистрация туристов фирмы "С нами не соскучишься"

Поиск и редактирование

Активизирует диалоговое окно Поиск

Фильтр и его отмена

Создает в заголовках полей базы данных раскрывающиеся списки со средствами фильтрации данных. Повторное нажатие на кнопку удаляет эти списки

Фильтрация оплаченных путевок

Активизирует диалоговое окно Фильтрация

Сортировка

Сортирует данные в алфавитном порядке по направлениям туров

Сводная -таблица

Создает на отдельном рабочем листе сводную таблицу, в которой подсчитывает суммарную продолжительность оплаченных и неоплаченных путевок по каждому из направлений туров

b

Сохраняет данные по принципу команды Сохранить (Save)

я

Сохраняет данные по принципу команды Сохранить как (Save as)

В пользовательском меню Файл имеются только три пункта: сохранить, сохранить как И Закрыть.
Перейдем теперь к тексту программы. В своей структуре она имеет несколько модулей. Проанализируем работу этой программы, последовательно обсудив каждый из ее модулей.

Модуль Модуль 1

Описываются переменные уровня проекта.

Option Explicit
Public СписокНайденных () As String
Public Фамилия As String
'
' При поиске клиента по фамилии в соответствии с используемым в приложении
' алгоритмом на длину фамилии не налагается ограничений
'
Public Имя As String * 20
Public Пол As String * 3
Public ВыбранныйТур As String * 20
Public Оплачено As String * 3
Public Фото As String * 3
Public Паспорт As String * 3
Public Срок As String * 3
Public НомерСтроки As Integer
Public НайденнаяЗапись As Integer
Public Продолжительность As Integer

Модуль
ThisWorkbook

Создается пользовательское меню и панели инструментов, а также заголовок окна пользовательского приложения. Устанавливается связь между кнопками пользовательской панели инструментов и процедурами модуля, которые инициализируют соответствующие диалоговые окна или выполняют указанные действия. Устанавливается режим работы, при котором весь пользовательский интерфейс прекращает свое существование при закрытии приложения. Процедура workbook_WindowActivate создает пользовательский интерфейс при загрузке книги. Процедура workbook windowDeactivate восстанавливает интерфейс, используемый в окне рабочей книги Excel по умолчанию.

Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
'
' Процедура создания новой панели инструментов и новое меню при
' открытии рабочей книги
'
' При открытии рабочей книги панели инструментов Форматирование
' и Стандартная скрываются и отображается новый заголовок окна приложения
With Application
.Caption = "С нами не соскучишься"
.DisplayAlerts = False
.CoirmandBars ("Formatting") .Visible = False
.ContmandBars ("Standard") .Visible = False
End With
'
' Создание новой панели инструментов с именем
' Рабочая панель инструментов, которая будет
' удаляться при закрытии приложения
'
With Application.CommandBars.Add(Nаmе:="Рабочая панель инструментов", Position:=msoBarTop, MenuBar:=False, Temporary:=True)
.Visible = True
With .Controls
'
' Первая кнопка
'
With .Add(Type:=msoContro!Button, Id:=l)
.Caption = "Регистрация"
.TooltipText = "Регистрация клиентов"
.Style = msoButtonCaption
.OnAction = "Модуль1.UserForml_Initialize"
End With
'
' Вторая кнопка
'
With .Add(Typef=msoControlButton, Id:=l)
.Caption = "Поиск и редактирование"
.TooltipText = "Поиск и редактирование"
.Style = msoButtonCaption
.OnAction = "Модуль1.UserForm3_Initialize"
End With
'
' Третья кнопка
'
With .Add(Type:=msoControlButton, Id:=l)
.Caption = "Фильтр и его отмена"
.TooltipText = "Установка и снятие фильтра"
.Style = msoButtonCaption
.OnAction = "Модуль1.Автофильтр"
End With
'
' Четвертая кнопка
'
With .Add{Type:=msoControlButton, Id:=1)
.Caption = "Фильтрация оплаченных путевок"
.TooltipText = "Отображаются только оплаченные путевки"
.Style = msoButtonCaption
.OnAction = "Модуль1.UserForm4_Initialize"
End With
'
' Пятая кнопка
'
With .Add(Type:=msoControlButton, Id:=l)
.Caption = "Сортировка"
.TooltipText = "Сортировка данных"
.Style = msoButtonCaption
.OnAction = "Модуль1.Сортировка"
End With
End With
End With
'
' Вторая панель инструментов с именем Сводная таблица и файлы
'
With Application.CommandBars.Add(Name:="Сводная таблица и файлы", Position:=msoBarTop, MenuBar:=False, Temporary:=True)
.Visible = True
With .Controls
'
' Первая кнопка
'
With .Add(Type:=msoControlButton, Id:=l)
.Caption = "Сводная таблица"
.TooltipText = "Построение сводной таблицы"
.Style = msoButtonCaption
.OnAction = "Модуль1.СводнаяТаблица"
End With
'
' Вторая кнопка
'
With .Add(Type:=msoControlButton, Id:=3)
.TooltipText = "Сохранить"
.OnAction = "Модуль!.Запись"
End With
With .Add(Type:=msoControlButton, Id:=1175)
.TooltipText = "Сохранить как"
.OnAction = "Модуль1.СохранитьКак"
End With
End With
End With
With Application.CommandBars.Add(Name:="МоеМеню", MenuBar:=True, Temporary:=True)
.Visible = True
With .Controls
'
' Создание строки меню Файл
With .Add(Type:=msoControlPopup)
.Caption = "&Файл" With .Controls
With .Add(Type:=msoControlButton)
.Caption = "Сохранить"
.OnAction = "Модуль1.Запись"
End With
With .Add(Type:=msoControlButton)
.Caption = "Сохранить как"
.OnAction = "Модуль1.СохранитьКак"
End With
With .Add(Type:=msoControlButton)
.Caption = "Закрыть"
.OnAction = "Модуль1.Закрыть"
End With
End With
End With
End With
End With
End Sub
'
Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)
'
' Процедура, отображающая панели инструментов Форматирование
' и Стандартная при закрытии приложения
' Кроме того, она устанавливает заголовок окна приложения, используемые
' по умолчанию
'
With Application
.CommandBars("Formatting").Visible = True
.CoiranandBars("Standard").Visible = True
.Caption = Empty
End With
End Sub
Ранее при описании модуль1 были указаны переменные уровня проекта, теперь рассмотрим несколько его процедур.

Модуль
Модуль1

  • Процедура UserForm1_Initialize инициализирует диалоговое окно Регистрация туристов фирмы "С нами не соскучишься". Также при помощи вызова процедуры заголовок-листа в ней создаются заголовки полей базы данньгх на рабочем листе, в случае их отсутствия.
  • Процедура UserForm3_Initialize активизирует диалоговое окно Поиск.
  • Процедура userForm4_Initialize активизирует диалоговое окно Фильтрация.
  • Процедура сортировка упорядочивает данные по двум критериям: первоначальный критерий направление тура, второстепенный — оплата
  • Процедура Своднаятаблица создает рабочий лист Сводная-таблица со сводной таблицей ( 7). Столбцы сводной таблицы основаны на поле оплачено; строки — на поле направление тура, а результаты сводной таблицы подводятся суммированием по полю Продолжительность базы данных. На основе сводной таблицы строится диаграмма. При этом используется свойство TableRangel объекта PivotTable,
    возвращающее диапазон с данными сводной таблицы, что позволяет избежать необходимости явного описания диапазона, по которому строится диаграмма.
  • Процедура сохранитьКак активизирует встроенное диалоговое окно Сохранение документа.
  • Процедура закрыть закрывает приложение.

Public Sub UserForml_Initialize()
'
' Процедура активизации диалогового окна Регистрация туристов
' и задание элементов раскрывающегося списка
'
'
' Проверка наличия заголовка базы данных.
' Построение заголовка базы данных в случае его отсутствия
If Sheets("БазаДанных").Range("Al").Value <> "Фамилия" Then ЗаголовокЛиста
End If
'
' Задание элементов раскрывающегося списка
'
With UserForml
.CommandButtonl.Default = True
.CommandButton2.Cancel = True
.ComboBoxl.List = Array("Лондон", "Париж", "Берлин")
.ComboBoxl.Listlndex = 0
.OptionButtonl.Value = True
.SpinButtonl.Value = 1
.CheckBoxl.Value = False
.CheckBox2.Value = False
.CheckBox3.Value = False
End With
'
' Активизация диалогового окна
'
UserForml.Show
'
End Sub
Public Sub ЗаголовокЛиста()
With Sheets("БазаДанных")
.Range("Al").Value = "Фамилия"
.Range("Bl").Value = "Имя"
.Range("Cl").Value = "Пол"
.Range("Dl").Value = "Направление тура"
.Range("El").Value = "Оплачено"
.Range("Fl").Value = "Фото сданы"
.Range("Gl").Value = "Паспорт сдан"
.Range("HI").Value = "Продолжительность"
.Range("A:A").ColumnWidth = 9.43
.Range ("B:C") .ColuimWidth = 8.43
.Range("D:D").ColumnWidth = 13.43
.Range'("E:E") .ColumnWidth = 10.14
.Range("F:F").ColumnWidth = 9
.Range("G:G").ColumnWidth = 8.43
.Range("H:H").ColumnWidth = 19.14
End With
'
Sheets("БазаДанных").Rows("1:1")
.Select With Selection
.Font.Bold = True
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True With .Interior
.Colorlndex = 36
.Pattern = xlSolid
End With
End With
Sheets("БазаДанных").Rows("2:2")
.Select ActiveWindow.FreezePanes = True
End Sub
'
Public Sub Запись ()
ActiveWorkbook.Save
End Sub '
Private Sub UserForm3_Initialize()
'
' Процедура активизации диалогового окна Поиск
'
UserFormS.Show End Sub
Private Sub Автофильтр()
' Процедура вызова команды Автофильтр
'
Sheets("БазаДанных").Range("A1:H1").Select Selection.AutoFilter
End Sub
Private Sub UserForm4_Initialize()
'
' Процедура активизации диалогового окна фильтрации
'
With UserForm4
.OptionButtonl.Value = True
.Show End With End Sub
'
Private Sub Сортировка()
'
' Процедура сортировки данных
' Первоначальный критерий сортировки - направление тура,
' второстепенный - произведение оплаты
Dim n Аs Integer '
' n - вспомогательная переменная '
Sheets("БазаДанных").Range("A2").Select
n = Selection. CurrentRegion. Rows. Count '
' Определение числа записей в базе данных
'
Worksheets("БазаДанных").Range(Cells(2, 1),
Cells(n + 1, 8))
.Sort keyl—Worksheets("БазаДанных")
.Range("D2"), orderl:=xlAscending,
key2:=Worksheets("БазаДанных").Range("E2")," _
order2:=xlDescending
'
' Сортировка по турам в возрастающем,
' а по оплате - в убывающем порядке
'
End Sub
Private Sub СводнаяТаблица ()
'
' Процедура построения сводной таблицы
'
Dim n As Integer
'
'
Dim Списки, Назначение As String
Dim Лист As Object
Dim ИмяКниги As String
ИмяКниги = ActiveWorkbook.Name
'
' Исключаем расширение из имени книги '
For i = 1 То Len(ИмяКниги)
If Mid(ИмяКниги, i, 1) = "." Then
ИмяКниги = Mid(ИмяКниги, 1, i - 1)
Exit For
End If
Next i
ИмяКниги = Trim(ИмяКниги)
' Удаляются ранее созданные рабочие листы с именем .СводнаяТаблица
For Each Лист In Worksheets
If Лист.Name = "СводнаяТаблица" Then Sheets("СводнаяТаблица").Delete
End If
Next Лист
' Создается новый рабочий лист с именем СводнаяТаблица
'
Worksheets.Add
ActiveSheet.Name = "СводнаяТаблица"
n = Worksheets("БазаДанных").Range("A2")
.CurrentRegion.Rows.Count
'
'
' Определение диапазона, по которому будет строиться
' сводная таблица (Списки) и
где она будет расположена (Назначение).
' Эти диапазоны записываются в виде строковых выражений
Списки = "БазаДанных!R1C1:R" & CStr(n) & "С8"
Назначение = "[" & ИмяКниги & "]СводнаяТаблица!R1C1"
'
' Создание сводной таблицы '
ActiveSheet.PivotTableWizard
SourceType:=xlDatabase,
SourceData:=Cписки,
TableDestination:=Hазвание, ТаblеNаmе:="Отчет"
ActiveSheet.PivotTables("Отчет").AddFields
RowFields:="Направление тура", ColumnFields:="Оплачено"
With ActiveSheet.PivotTables("Отчет")
.PivotFields("Продолжительность")
.Orientation = xlDataField
.Name = "Сумма по полю Продолжительность"
.Function = xlSum End With
'
' Построение диаграммы по сводной таблице
'
Dim СводнаяТаблица As PivotTable
Dim Диапазон As Range
Set СводнаяТаблица = ActiveSheet.PivotTables("Отчет")
With ActiveSheet.PivotTables("Отчет")
'
' He отображаются итоги по строкам и столбцам
'
.RowGrand = False .ColumnGrand = False
End With
'
' Определение диапазона из сводной таблицы,
' по которому строится диаграмма
'
Set Диапазон = ActiveSheet.PivotTables("Отчет").TableRangel
'
' Построение диаграммы
'
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Диапазон,
PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject,
Name:="СводнаяТаблица"
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _
"Продолжительность оплаченных/неоплаченных поездок"
End With
'
End Sub
'
Sub СохранитьКак()
'
' Процедура активизирует встроенное окно Сохранение документа
'
Application.Dialogs(xlDialogSaveAs).Show
End Sub
'
Sub Закрыть()
'
' Процедура закрытия приложения
'
Application,Quit
End Sub

Модуль
UserForml

Программа считывает информацию с диалогового окна Регистрация туристов фирмы "С нами не соскучишься" (рис. У 10.3) и обеспечивает ввод набранных в нем данных в рабочий лист БазаДанных.

  • Нажатие кнопки ок активизирует процедуру CommandButton1_Click по считыванию информации с диалогового окна и заполнению базы данных.
  • Счетчик активизирует процедуру SpinButton1_Change, которая вводит значения счетчика в поле продолжительность тура.
  • Процедура TextBox3_Change синхронизирует вводимые данные в поле продолжительность тура со значением счетчика.
  • Нажатие кнопки Отмена активизирует процедуру CommandButton2_Сlick, которая закрывает диалоговоеокно Регистрация туристов фирмы "С нами не соскучишься" .

Private Sub CommandButtonl_Click()
' В переменную НомерСтроки вводится номер первой пустой строки
' рабочего листа БазаДанных
НомерСтроки = Application.CountA(Sheets("БазаДанных").Range("A:A")) + I
'
' Считывание информации в переменные из диалогового окна
With UserForml
Фамилия = .TextBoxl.Text Имя = .TextBox2.Text
Продолжительность = .TextBox3.Text
If .OptionButtonl.Value = True Then
Пол = "Муж"
Else
Пол = "Жен"
End If
If ..CheckBoxl.Value = True Then
Оплачено = "Да"
Else
Оплачено = "Нет"
End If
If .CheckBox2.Value = True Then
Фото'= "Да"
Else
Фото = "Нет"
End If
If .CheckBoxS = xlOn Then
Паспорт = "Да"
Else
Паспорт = "Нет"
End If
ВыбранныйТур = .ComboBoxl.Text
End With
'
' Запись данных на рабочий лист БазаДанных
'
With Sheets("БазаДанных")
.Cells(НомерСтроки, 1).Value = Фамилия
.Cells(НомерСтроки, 2).Value = Имя
.Cells(НомерСтроки, 3).Value = Пол
.Cells(НомерСтроки, 4).Value = ВыбранныйТур
.Cells(НомерСтроки, 5).Value = Оплачено
.Cells(НомерСтроки, 6).Value = Фото
.Cells(НомерСтроки, 7).Value = Паспорт
.Cells(НомерСтроки, 8).Value = Продолжительность
End With
End Sub
'
Private Sub CommandButton2_Click()
'
' Процедура закрытия диалогового окна UserForml.Hide
End Sub
Private Sub SpinButtonl_Change()
'
' Процедура .ввода числа со счетчика в поле ввода
'
With UserForml
.TextBoxS.Text = CStr(.SpinButtonl.Value)
End With
End Sub
Private Sub TextBox3_Change()
'
' Процедура установки значения счетчика из поля ввода
With UserForml
.SpinButtonl.Value = CInt(.TextBox3.Text)
End With
'
End Sub

Модуль
UserForm3

Программа ищет по фамилии, введенной в поле Фамилия диалогового окна поиск ( 4), подходящих клиентов в базе данных. Если такие имеются, то список вариантов найденных клиентов в базе данных с указанием фамилий, имен и номеров записей, отображается в раскрывающемся списке Найденные варианты. В противном случае выдается сообщение о неудачном поиске ( 8).

  • Нажатие кнопки поиск активизирует процедуру CommandButton1_Click, которая производит поиск клиентов и отображает список найденных вариантов.
  • Нажатие кнопки Редактировать активизирует процедуру CommandButton2_Click, которая закрывает диалоговое окно поиск и активизирует диалоговое окно перерегистрация туристов фирмы "С нами не соскучишься" ( 5), заполняя его информацией о выбранном клиенте.
  • Нажатие кнопки отмена активизирует процедуру CommandButton3_Click, которая закрывает диалоговое окно Поиск.

 

Private Sub CommandButtonl_Click()
' Процедура поиска клиента
'
'
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim Строка As Integer
'
' i ,j и n - вспомогательные переменные
' В переменной i перебираются номера строк из базы данных,
' начиная со второй и заканчивая последней непустой строкой,
' номер которой определен в переменной Строка.
' Переменная j выполняет роль счетчика,
' учитывающего текущее количество отобранных вариантов.
' Если отобранных вариантов нет, то j присваивается 0.
' n присваивается конечному значению счетчика j
Dim Тест As String
'
' Тест - вспомогательная переменная, в которую вводится очередная
' проверяемая фамилия
'
Dim СписокНайденных() As String
Строка = Application.CountA(Sheets("БазаДанных").Columns(1)}
Фамилия = UserForm3.TextBoxl.Text
i = 2
j = 0
Do While i <= Строка
Тест = Sheets("БазаДанных").Cells (i, 1).Text
If IsNumeric(Application.Search(Фамилия, Тест)) = True Then
j = j + 1
End If
i = i + 1
Loop
If j = 0 Then
MsgBox "Вышла промашка. А клиента таково и в помине нет.",
vbExclamation, "Поиск" НайденнаяЗапись = 0
Exit Sub
End If
n = j
ReDim СписокНайденных(1 To n, 0 To 2) As String
' Двумерный динамический массив СписокНайденных используется для заполнения
' раскрывающегося списка с возможными вариантами клиентов.
' Первый и второй столбцы массива содержат фамилию и имя клиента,
' а третий - номера строки из рабочего листа БазаДанных,
' в которой записана информация о клиенте
'
'
i = 2
j = 0
Do While i <= Строка
Тест = Sheets("БазаДанных").Cells(i, 1).Text
If IsNumeric(Application.Search(Фамилия, Тест)) = True Then
j = j + 1
СписокНайденных(j, 0} = Тест
СписокНайденных(j, 1) = Sheets("БазаДанных").Cells(i, 2).Text
СписокНайденных(j , 2) = CStr(i)
End If
i = i + 1
Loop
'
' Заполнение раскрывающегося списка
'
With UserForm3.ComboBoxl
.Clear
.ColumnHeads = True
.ColumnCount = 3
.ColumnWidths = "60;60;10"
.List = СписокНайденных()
.Listlndex = 0
End With
' Ввод в переменную НайденнаяЗапись номера строки с
' первым клиентом, выведенным в раскрывающийся список
'
НайденнаяЗапись = CInt(СписокНайденных(1, 2))
End Sub
Private Sub CommandButton2_Click()
'

' Процедура закрытия диалогового окна Поиск,
' открытия диалогового окна Перерегистрация туристов
' и заполнением его информацией о найденном туристе
'
' Закрывается диалоговое окно Поиск
UserForm3.Hide
'
Dim n As Integer
'
' n - вспомогательная переменная, используемая для
' ввода из базы данных в раскрывающийся список
' направления тура найденного клиента
' (считывается из раскрывающегося списка
' номер строки выбранного клиента)
НайденнаяЗапись = UserForm3.ComboBoxl. List(UserForm3.ComboBoxl.Listlndex, 2)
' Если клиент не найден, то процедура информирует об этом,
' напоминая, что перед редактированием должен быть найден клиент
'
If НайденнаяЗапись = 0 Then
MsgBox "Сначала надо найти клиента", vblnformation, "Редактирование"
Exit Sub
End If
' Ввод из базы данных в диалоговое окно Редактирование
' информации о найденном клиенте
'
With UserForm2
.TextBoxl:Text = Sheets("БазаДанных")
.Cells(НайденнаяЗапись, 1)
.Value .TextBox2.Text = Sheets("БазаДанных")
.Cells(НайденнаяЗапись, 2).Value
.TextBox3.Text = Sheets("БазаДанных")
.Cells(НайденнаяЗапись, 8).Value
If Sheets("БазаДанных").Cells(НайденнаяЗапись, 3)
.Value = "Муж" Then
.OptionButtonl.Value = True
.OptionButton2.Value = False Else
.OptionButtonl.Value = False
.OptionButton2.Value = True End If If Sheets("БазаДанных")
.Cells(НайденнаяЗапись, 5)
.Value = "Да" Then
.CheckBoxl.Value = True Else
.CheckBoxl.Value = False
End If
If Sheets("БазаДанных").Cells(НайденнаяЗапись, 6)
.Value = "Да" Then
.CheckBox2.Value = True Else
.CheckBox2.Value = False
End If
If Sheets("БазаДанных").Cells(НайденнаяЗапись, 7)
.Value = "Да" Then
.CheckBox3.Value = True
Else
.CheckBox3.Value - False
End If
.ComboBoxl.List = Array("Афины", "Берлин", "Лондон")
ВыбранныйТур = Cells(НайденнаяЗапись, 4)
.Value Select Case ВыбранныйТур Case Is = "Афины"
n = 0 Case Is = "Берлин"
n = 1 Case Is = "Лондон"
n = 2
End Select
.ComboBoxl.Listlndex = n .Show
End With
'
End Sub '
Private Sub CortroandButton3_Click ()
'
' Процедура закрытия диалогового окна
'
UserForm3.Hide
End Sub

Модуль
UserForm2

  • Нажатие кнопки Запись в архив активизирует процедуру CommandButton1_Click, которая из диалогового окнаПеререгистрация туристов фирмы "С нами не соскучишься" ( 5) вводит данные на рабочий лист Архив.
  • Нажатие кнопки отмена активизирует процедуру ConmandButton2_Click, закрывающую диалоговое окно.
  • Нажатие кнопки Удалить активизирует процедуру CommandButton3_Click, которая удаляет запись из базы данных.
  • Нажатие кнопки Ввести изменения активизирует процедуру commandButton4 click, которая вводит внесенные : изменения в запись базы данных.

Private Sub CommandButtonl_Click()
'
' Процедура записи на рабочий лист Архив
Dim Строка As Integer '
' Строка - вспомогательная переменная, которой присваивается
' номер первой пустой строки рабочего листа Архив
' Копирование строки из рабочего листа БазаДанных в буфер обмена
'
Sheets("БазаДанных"}.Rows(НайденнаяЗапись).Сору
'
' Вставка в рабочий лист Архив содержания буфера обмена
'
With Sheets("Архив")
Строка-= Application.CountA(.Columns(1)) + 1
.Paste Destination:=.Rows(Строка)
End With
End Sub
Private Sub CommandButton2_Click()
' Закрытие диалогового окна Редактирование
UserForm2.Hide ' Обнуляется номер найденной записи
НайденнаяЗапись = 0
End Sub
Private Sub CommandButton3_Click()
'
' Процедура удаления строки из рабочего листа БазаДанных
НайденнаяЗапись = Sheets("БазаДанных").Cells(1, 20).Value
' Удаление записи
'
Sheets("БазаДанных").Rows(НайденнаяЗапись).Select
Selection.Delete
'
' Закрытие диалогового окна Редактирование
'
UserForm2.Hide '
' Обнуление переменной с номером строки
НайденнаяЗапись = 0
Sheets("БазаДанных").Cells(1, 20).Value = Empty
End Sub
Private Sub CommandButton4_Click()
'
' Процедура записи в базу данных измененной информации
'
' Считывание информации из диалогового окна "Редактирование"
' в переменные
With UserForm2
'
Фамилия = .TextBoxl.Text
Имя = .TextBox2.Text
Продолжительность = CInt(.TextBox3.Text)
If .OptionButtonl.Value = True Then
Пол = "Муж" Else
Пол = "Жен"
End If
If .CheckBoxl.Value = True Then
Оплачено = "Да" Else
Оплачено = "Нет"
End If
If .CheckBox2.Value = True Then
Фото = "Да"
Else
Фото = "Нет"
End If
If .CheckBoxS.Value = True Then
Паспорт = "Да"
Else
Паспорт = "Нет"
End If
ВыбранныйТур = .ComboBoxl.Text
End With
НайденнаяЗапись = Sheets("БазаДанных") .Cells (1, 20).Value '
' Запись редактируемой информации о клиенте в базу данных
With Sheetst"БазаДанных")
.Cells(НайденнаяЗапись, 1)
.Value = Фамилия
.Cells(НайденнаяЗапись, 2)
.Value = Имя
.Cells(НайденнаяЗапись, 3)
.Value = Пол
.Cells(НайденнаяЗапись, 4)
.Value = ВыбранныйТур
.Cells(НайденнаяЗапись, 5)
.Value = Оплачено
.Cells(НайденнаяЗапись, 6)
.Value = Фото
.Cells(НайденнаяЗапись, 7)
.Value = Паспорт
.Cells(НайденнаяЗапись, 8)
.Value = Продолжительность
End With
End Sub
Private Sub SpinButtonl_Change()
TextBox3.Text = CStr(SpinButtonl.Value)
End Sub

Модуль
UserForm4

  • Нажатие кнопки Фильтрация диалогового окна Фильтрация ( 6) активизирует процедуру CommandButton1_Click, которая производит фильтрацию данных из базы данных в зависимости от выбранного критерия фильтрации в группе Путевка .
  • Нажатие кнопки Отмена активизирует процедуру CommandButton2_Сlick, которая закрывает диалоговое окно Фильтрация.

 

Private Sub CommandButtonl_Click()
' Процедура фильтрации по критерию
Dim Flag As String
' Flag устанавливает критерий фильтрации по третьему столбцу
'
Sheets("БазаДанных").Rows(1).Select Selection.AutoFilter
With UserForm4
If .OptionButtonl.Value = True Then Flag = "Да"
If .OptionButton2.Value = True Then Flag = "Нет"
End With
'
' Считывание критерия из диалогового окна для фильтрации
Sheets("БазаДанных").Rows(l).Select Selection.AutoFilter
Selection.AutoFilter Field:=5, Criteria1:=Flag
'
' Фильтрация по критерию
'
End Sub
'
Private Sub CommandButton2_Click()
'
' Закрытие диалогового окна Фильтрация
'
UserForm4.Hide End Sub
Самостоятельное задание
Построить приложение, учитывающее движение товара на складе магазина "Все, чего душа пожелает". В диалоговом окне приема товара на склад ( 9) предусмотреть ввод наименования товара, цену, количество, дату приема и единицу измерения товара. Поступающие товары должны записываться в базу данных рабочего листа Склад.
Единицу измерения товара следует вводить при помощи раскрывающегося списка. Первоначально, в списке задать две единицы измерения: кг и штук. При появлении товара с новой единицей измерения, например литр, первый раз эта единица измерения вводится в раскрывающийся список вручную, после чего программа должна автоматически расширить список используемых единиц измерения, добавив в него введенную величину.
Предусмотреть в приложении средства поиска товара. При продаже товара записывать информацию о проданном товаре в базу данных, хранящуюся на рабочем листе продано. При списании товара записывать информацию о нем в базу данных, хранящуюся на рабочем листе Списание. Обеспечить программную фильтрацию, сортировку данных и построение обобщающих сводных таблиц как по проданным, так и по списанным и находящимся еще на складе товарам.
Следующая процедура является примером того, как можно автоматически добавлять в раскрывающийся список новые элементы. В диапазон A1:А2 рабочего листа, на основе которого строится раскрывающийся список, введем кг и штук ( 10). При вводе в поле раскрывающегося списка нового элемента, отличного от предыдущих, и нажатии кнопки CommandButton1, этот элемент программно вводится в ячейку АЗ. Теперь раскрывающийся список автоматически будет строиться по диапазону A1 : АЗ и т. д.
Private Sub CommandButtonl_Click()
Dim Диапазон As String
'
' Диапазон, на основе которого строится поле со списком
'
Dim n, i As Integer
'
' n - число элементов в диапазоне
'
Dim Новый As String
'
' Новый - .элемент, вводимый в поле со списком
n = Application.CountAfRange("A:A"))
Новый = ComboBoxl.Text
'
' Проверка, совпадает ли элемент, вводимый в поле со списком,
' с каким-либо элементом списка. Если не совпадает, то
' он добавляется в конец диапазона, по которому строится список
'
If ComboBoxl.MatchFound = False Then
Cells(n + 1, .1).Value = Новый
Диапазон = "A1:A" & CStr(n + 1)
ComboBox1.RowSource = Диапазон
End If
End Sub
'
Private Sub UserForm_Initialize()
Dim Диапазон As String
Dim n As Integer
n = Application.CountA(Range("A:A"))
Диапазон = "A1:A" & CStr(n)
ComboBoxl.RowSource = Диапазон
UserForml.Show
End Sub

 

 
На главную | Содержание | < Назад....Вперёд >
С вопросами и предложениями можно обращаться по nicivas@bk.ru. 2013 г. Яндекс.Метрика