Пример2

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

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

Диалоговое окно	Назначение	Форма
Регистрация туристов фирмы "С нами не соскучишься" (рис. У10.3)	Для заполнения рабочего листа БазаДан-ных	UserForm1
Поиск (рис. У10.4)	Производит поиск клиента по фамилии. В фамилии клиента допустимо использовать символ <*> вместо группы любых символов, символ <?> вместо любого одного символа. В результате поиска, в случае отсутствия подходящих клиентов выдается соответствующее сообщение. Если подходящие клиенты найдены, в раскрывающемся списке выводится список их фамилий и имен. Выбрав требуемого клиента и нажав кнопку Редактировать, пользователь переходит к этапу редактирования информации о клиенте	UserForm3
Перерегистрация туристов фирмы "С нами не соскучишься" (рис. У1 0.5)	В него загружается информация о найденном клиенте. Допустимо любое редактирование информации с последующей заменой старой информации о клиенте на новую в базе данных. Также возможна запись информации в архив и ее удаление из базы данных.	UserForm2
Фильтрация (рис. У10.6)	В зависимости от выбранного переключателя отображает только оплаченные или только не оплаченные путевки.	UserForm4

Рис. У10.1. Рабочий лист БазаДанных

Рис. У10.2. Рабочий лист Архив

Рис. У 10.3. Диалоговое окно Регистрация туристов фирмы "С нами не соскучишься"

Рис. У10.4. Диалоговое окно Поиск

Рис. У10.5. Диалоговое окно Перерегистрация туристов фирмы "С нами не соскучишься"

Рис. У10.6. Диалоговое окно Фильтрация

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

Кнопка	Назначение
Регистрация	Активизирует диалоговое окно Регистрация туристов фирмы "С нами не соскучишься"
Поиск и редактирование	Активизирует диалоговое окно Поиск
Фильтр и его отмена	Создает в заголовках полей базы данных раскрывающиеся списки со средствами фильтрации данных. Повторное нажатие на кнопку удаляет эти списки
Фильтрация оплаченных путевок	Активизирует диалоговое окно Фильтрация
Сортировка	Сортирует данные в алфавитном порядке по направлениям туров
Сводная -таблица	Создает на отдельном рабочем листе сводную таблицу, в которой подсчитывает суммарную продолжительность оплаченных и неоплаченных путевок по каждому из направлений туров
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 активизирует диалоговое окно Фильтрация. Процедура сортировка упорядочивает данные по двум критериям: первоначальный критерий направление тура, второстепенный — оплата Процедура Своднаятаблица создает рабочий лист Сводная-таблица со сводной таблицей (рис. У10.7). Столбцы сводной таблицы основаны на поле оплачено; строки — на поле направление тура, а результаты сводной таблицы подводятся суммированием по полю Продолжительность базы данных. На основе сводной таблицы строится диаграмма. При этом используется свойство TableRangel объекта PivotTable, возвращающее диапазон с данными сводной таблицы, что позволяет избежать необходимости явного описания диапазона, по которому строится диаграмма. Процедура сохранитьКак активизирует встроенное диалоговое окно Сохранение документа. Процедура закрыть закрывает приложение.

Рис. У10.7. Рабочий лист СводнаяТаблица

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

Программа ищет по фамилии, введенной в поле Фамилия диалогового окна поиск (рис. У10.4), подходящих клиентов в базе данных. Если такие имеются, то список вариантов найденных клиентов в базе данных с указанием фамилий, имен и номеров записей, отображается в раскрывающемся списке Найденные варианты. В противном случае выдается сообщение о неудачном поиске (рис. У10.8). Нажатие кнопки поиск активизирует процедуру CommandButton1_Click, которая производит поиск клиентов и отображает список найденных вариантов. Нажатие кнопки Редактировать активизирует процедуру CommandButton2_Click, которая закрывает диалоговое окно поиск и активизирует диалоговое окно перерегистрация туристов фирмы "С нами не соскучишься" (рис. У10.5), заполняя его информацией о выбранном клиенте. Нажатие кнопки отмена активизирует процедуру CommandButton3_Click, которая закрывает диалоговое окно Поиск.

Рис. У10.8. Сообщение о неудачном поиске клиента

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