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, которая из диалогового окнаПеререгистрация туристов фирмы "С нами не соскучишься" (рис. У10.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

Нажатие кнопки Фильтрация диалогового окна Фильтрация (рис. У10.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

Следующая процедура является примером того, как можно автоматически добавлять в раскрывающийся список новые элементы. В диапазон 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