В разрабатываемом
в данном уроке приложении создается база данных туристической фирмы "С
нами не соскучишься" на рабочем листе с пользовательским интерфейсом и
средствами анализа, поиска и обработки информации, хранимой в базе данных. Предусмотрена
архивация и удаление выбранных записей базы данных.
В процессе
разработки данного приложения вы на практике освоите:
В этом уроке
строится приложение с пользовательским интерфейсом по заполнению и обработке
базы данных туристической фирмы "С нами не соскучишься". База данных
состоит из двух рабочих листов: БазаДанных (рис. У 10.1) и Архив (рис. У10.2).
Кроме того, при построении сводной таблицы по базе данных создается рабочий
лист своднаяТаблица.
Рис.
У10.1. Рабочий лист БазаДанных
Рис.
У10.2. Рабочий лист Архив
После загрузки
программа сама будет создавать свой интерфейс, отображать название окна приложения
и если на рабочих листах нет заголовков полей, то создавать их. Интерфейс программы
будет состоять из нескольких диалоговых окон.
Диалоговое
окно |
Назначение |
Форма |
||
Регистрация
туристов фирмы "С нами не соскучишься" (рис. У10.3) |
Для заполнения
рабочего листа БазаДан-ных |
UserForm1 |
||
Поиск (рис.
У10.4) |
Производит поиск
клиента по фамилии. В фамилии клиента допустимо использовать символ
<*> вместо группы любых символов, символ <?> вместо любого
одного символа. В результате поиска, в случае отсутствия подходящих
клиентов выдается соответствующее сообщение. Если подходящие клиенты
найдены, в раскрывающемся списке выводится список их фамилий и имен.
Выбрав требуемого клиента и нажав кнопку Редактировать, пользователь
переходит к этапу редактирования информации о клиенте |
UserForm3 |
||
Перерегистрация
туристов фирмы "С нами не соскучишься" (рис. У1 0.5) |
В него загружается
информация о найденном клиенте. Допустимо любое редактирование информации
с последующей заменой старой информации о клиенте на новую в базе
данных. Также возможна запись информации в архив и ее удаление из
базы данных. |
UserForm2 |
||
Фильтрация (рис.
У10.6) |
В зависимости
от выбранного переключателя отображает только оплаченные или только
не оплаченные путевки. |
UserForm4 |
||
Рис.
У 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 |
|
||
Рис.
У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) и обеспечивает ввод набранных в нем данных в рабочий лист БазаДанных.
|
||
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).
|
||
Рис.
У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
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 |
|
||
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 |
|
||
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
Построить
приложение, учитывающее движение товара на складе магазина "Все, чего душа
пожелает". В диалоговом окне приема товара на склад (рис. У10.9) предусмотреть
ввод наименования товара, цену, количество, дату приема и единицу измерения
товара. Поступающие товары должны записываться в базу данных рабочего листа
Склад.
Рис.
У10.9. Диалоговое окно Все, чего душа пожелает. Прием товара.
Единицу измерения
товара следует вводить при помощи раскрывающегося списка. Первоначально, в списке
задать две единицы измерения: кг и штук. При появлении товара с новой единицей
измерения, например литр, первый раз эта единица измерения вводится в раскрывающийся
список вручную, после чего программа должна автоматически расширить список используемых
единиц измерения, добавив в него введенную величину.
Рис.
У10.10. Автоматическое расширение элементов раскрывающегося списка
Предусмотреть
в приложении средства поиска товара. При продаже товара записывать информацию
о проданном товаре в базу данных, хранящуюся на рабочем листе продано. При списании
товара записывать информацию о нем в базу данных, хранящуюся на рабочем листе
Списание. Обеспечить программную фильтрацию, сортировку данных и построение
обобщающих сводных таблиц как по проданным, так и по списанным и находящимся
еще на складе товарам.
Следующая
процедура является примером того, как можно автоматически добавлять в раскрывающийся
список новые элементы. В диапазон A1:А2 рабочего листа, на основе которого строится
раскрывающийся список, введем кг и штук (рис. У10.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
Понятие же "физического вакуума" в релятивистской квантовой теории поля подразумевает, что во-первых, он не имеет физической природы, в нем лишь виртуальные частицы у которых нет физической системы отсчета, это "фантомы", во-вторых, "физический вакуум" - это наинизшее состояние поля, "нуль-точка", что противоречит реальным фактам, так как, на самом деле, вся энергия материи содержится в эфире и нет иной энергии и иного носителя полей и вещества кроме самого эфира.
В отличие от лукавого понятия "физический вакуум", как бы совместимого с релятивизмом, понятие "эфир" подразумевает наличие базового уровня всей физической материи, имеющего как собственную систему отсчета (обнаруживаемую экспериментально, например, через фоновое космичекое излучение, - тепловое излучение самого эфира), так и являющимся носителем 100% энергии вселенной, а не "нуль-точкой" или "остаточными", "нулевыми колебаниями пространства". Подробнее читайте в FAQ по эфирной физике.