Самоучитель VBA

         

ПХЯ У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

  • Нажатие кнопки Запись в архив активизирует процедуру 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



Содержание раздела