Подробное описание решения

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

Начнем с разработки структуры нашего будущего меню (рисунок 8).

Рис 8 – Структурная схема меню приложения

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

Для создания пользовательского меню используется объект CommandBar и семейство CommandBars (для программирования строк меню и панели инструментов). В семействе CommandBars хранятся все строки меню и панели инструментов конкретного приложения. Поэтому семейство CommandBars содержится в объекте Application (родительском приложении). В свою очередь каждый объект CommandBar содержит семейство объ­ектов CommandBarControls, состоящее из всех элементов управления данной панели инструментов. Свойство Controls объекта CommandBar возвращает семейство CommandBarControls, элементы которого относятся к одному из трех типов:

- CommandBarButton:

Кнопка или элемент меню, вызывающий выполнение команды или подпрограммы.

- CommandBarComboBox:

Сложно организованное меню, похожее на поле ввода, раскрываю­щийся список или поле со списком.

- CommandBarPopUp:

Вложенное меню.

В общем виде иерархию объектов CommandBars можно изобразить следующим образом (рисунок 9).

Рис 9 – Иерархия объекта CommandBar

Так как наша панель меню будет создаваться применительно ко всей активной рабочей книге, то процедуры, описывающие ее создание, следует разрабатывать в модуле «ЭтаКнига» (рисунок 10).

Начнем написание алгоритма с описания процедуры Workbook_Open, которая запускается автоматически сразу же при открытии приложения.

Private Sub Workbook_Open()

'Вызов процедуры создания

‘пользовательского меню

MenuBuilder

'Вызов процедуры для

’пользовательского меню

UserForm4.Show 'Вызов заставочного окна UserForm4

End Sub

Рис 10 – Расположение модуля «ЭтаКнига»

При этом будет вызвана процедура создания пользовательского меню MenuBuilder. А также выведена на экран форма UserForm4 (на рисунке 11), которая пред­ставляет собой заставку-приветствие и содержит всего одну процедуру CommandButton1_Click.

'UserForm4 предназначена для использования в качестве заставки при запуске

Private Sub CommandButton1_Click()

Unload UserForm4

End Sub

CommёandButton1_Click

UserForm4

Рис 11 – Запуск приложения

Рассмотрим алгоритм процедуры MenuBuilder, необходимой для того, чтобы создать меню пользователя для данного приложения.

Private Sub MenuBuilder()

'Построение пользовательского меню

'Переменная a будет переменной объектного типа CommandBar (Панель инструментов)

Dim a As CommandBar

'Создаем свою панель меню с помощью метода Add в родительском приложении Application

'Для этого обратимся к объекту CommandBars (Панель инструментов) и к его методу Add

'!!!Помните, что обращение к нижележащим объектам производится с помощью разделителя "." (точки)!!!

Set a = Application.CommandBars.Add(Name:="m", Po­sition:=msoBarTop, MenuBar:=True, Temporary:=True)

'Создание панели инструментов, где параметр:

'Name - имя нашей панели меню

'Position - положение на окне Excel (в на­шем случае выше всех остальных панелей)

' MenuBar - замена активной строки меню нашей строкой меню (True - Да, False - Нет)

' Temporary - указатель на то, удалять ли нашу панель после закрытия разрабатываемой программы

'(Если True, то удалять, если False, то сохранить)

'Здесь под переменной скрывается наша панель меню. Конечно, к ней можно бы было обращаться непосредственно

'Application.CommandBars(Name:="m"), но проще ис­пользовать для этого переменную типа Object (Объект)

With a'Сделаем нашу панель видимой с помощью свойства ‘Visible

.Visible = True

'Начнем создавать на нашей панели вложенные меню (семейство Controls объекта Command Bars)

With .Controls

'Добавим новое вложенное меню

With .Add(Type:=msoControlPopup)

'Добавление вложенного меню "Файл" на нашу панель меню

.Caption = "Файл" 'Название меню

With .Controls

With .Add(Type:=msoControlButton)

'Добавление пункта "Создать новый лист" в выпа­дающее меню "Файл"

.Caption = "Создать новый лист" 'Название пункта меню

.OnAction = "NewDoc" 'Запуск процедуры при вы­боре пункта "Создать новый лист" (расположена в Module1)

'Свойство .OnAction объекта Controls очень важно, так как оно по‘зволяет связать процедуру, которая Вы хотите, чтобы за­пускалась ‘при выборе (нажатии) данного пункта меню (элемента семейства ‘Controls), с этим пунктом

End With

With .Add(Type:=msoControlButton)

'Добавление пункта "Закрыть лист" в выпадающее меню "Файл"

.Caption = "Закрыть лист" 'Название пункта

.OnAction = "Close1" 'Запуск процедуры при выборе пункта "Закрыть лист" (расположена в Module1)

End With

With .Add(Type:=msoControlButton)

'Добавление пункта "Выход" в выпадающее меню "Файл"

.Caption = "Выход" 'Название пункта

.OnAction = "ExitDoc" 'Запуск процедуры при вы­боре пункта "Выход" (расположена в Module1)

End With

End With

End With

'Создадим второе всплывающее меню "Сервис" на нашей па­нели

With .Add(Type:=msoControlPopup)

.Caption = "Сервис"

'С помощью метода Controls.Add добавим к новому меню не­сколько пунктов

With .Controls

With .Add(Type:=msoControlButton)

.Caption = "Добавить запись" 'Пункт "Добавить за­пись"

.OnAction = "Enter" 'Вызов процедуры, отвечающей за ввод дан‘ных при выборе данного меню

End With

With .Add(Type:=msoControlButton)

.Caption = "Удалить запись" 'Пункт "Удалить за­пись"

.OnAction = "Remove" 'Вызов процедуры удале­ния вы‘деленной записи при выборе пункта "Удалить запись"

End With

With .Add(Type:=msoControlButton)

.Caption = "Забронировать билет" 'Пункт "Забро­нировать билет"

.OnAction = "Z_b" 'Вызов процедуры заказа би­лета

‘ при выборе пункта "Забронировать билет"

End With

With .Add(Type:=msoControlButton)

.Caption = "Сортировка" 'Пункт “Сортировка”

.OnAction = "Sort" 'Вызов процедуры сортировки

‘ при выборе пункта "Сортировка"

End With

With .Add(Type:=msoControlButton)

.Caption = "Поиск" 'Пункт "Поиск"

.OnAction = "Find" 'Вызов процедуры поиска ‘при выборе ‘пункта "Поиск"

End With

End With

End With

'Создадим последнее третье вложенное меню "Справка" на нашей

‘панели меню

With .Add(Type:=msoControlPopup)

.Caption = "Справка" 'Название меню

With .Controls

'Создадим в этом меню пункт "О программе"

With .Add(Type:=msoControlButton)

.Caption = "О программе"

.OnAction = "AboutProg" 'Вызов процедуры,

‘представляющей информацию о программе

.Style = msoButtonIconAndCaption 'Разрешим помещение ‘картинки рядом с названием пункта

'Создание значка для пункта меню

.FaceId = 466 'Задание значка с кодом 466

End With

End With

End With

End With

End With

End Sub

Результатом работы данной процедуры будет панель меню следующего вида (рисунки 12, 13, 14, 15).

Рис 12 – Внешний вид панели меню Рис 13 – Вложенное меню Файл

Рис 14 – Вложенное меню Сервис Рис 15 – Вложенное меню Справка

Рассмотрим работу каждого пункта меню подробно. Начнем с пункта Создать новый лист меню Файл, отвечающего за создание нового листа Excel, на котором будет расположена вся информация о рейсах.

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

Public Sub NewDoc()

'Открытие формы для создания нового листа

UserForm6.Show

End Sub

'UserForm6 используется для ввода имени нового рабо­чего листа и его создания

Private Sub CommandButton1_Click()

Dim i As Boolean, a As String, w As Work­sheet

i = False

Do

a = CStr(UserForm6.TextBox1)

For Each ws In Worksheets

'Проверим, существует ли лист с таким же именем, созданный ранее,

'и не ввели ли мы по ошибке пустую строку как имя нового листа

If ws.Name = a Or a = "" Then

MsgBox "Лист с данным именем уже существует либо был сделан некорректный ввод!", _

vbCritical, "Ошибка": Exit Sub

Else: i = True: End If

Next

Loop Until i = True

'Для добавления нового листа в текущую книгу восполь­зуемся методом

'Sheets.Add

Sheets.Add

'Присвоим новому текущему рабочему листу введенное нами имя

ActiveSheet.Name = a

create

'Вызов процедуры, отвечающей за формирования внеш­него вида базы данных на новом листе Excel

Unload Me

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Private Sub UserForm_Initialize()

UserForm6.TextBox1.SetFocus

End Sub

Форма выглядит следующим образом (рисунок 16).

Создадим новый рабочий лист (рисунки 17, 18).

Рис. 16 – Внешний вид формы UserForm6

Рис 17 – Ввод имени нового рабочего листа

Рис 18 – Создание нового рабочего листа

Создание заголовков и оформление ячеек будущей базы данных проис­ходит в процедуре create, расположенной в модуле Module1.

Public Sub create()

'Задание заголовков и ширины столбцов

Range("1:1").Select: Selection.Font.FontStyle = "полужирный": Range("A1:A1").Select

Worksheets(ActiveSheet.Name).Cells(1, 1) = "№ рейса"

Worksheets(ActiveSheet.Name).Cells(1, 2) = "Промежуточный пункт"

Worksheets(ActiveSheet.Name).Cells(1, 3) = "Конечный пункт"

Worksheets(ActiveSheet.Name).Cells(1, 4) = "Время отправления"

Worksheets(ActiveSheet.Name).Cells(1, 5) = "Кол-во свободных мест"

Columns("A:A").ColumnWidth = 12: Col­umns("B:B").ColumnWidth = 27

Columns("C:C").ColumnWidth = 27: Col­umns("D:D").ColumnWidth = 25

Columns("E:E").ColumnWidth = 24

End Sub

Процедура Close1, расположенная в модуле Module1, удаляет текущий рабочий лист.

Public Sub Close1()

'Закрывает текущий рабочий лист с базой данных, путем его удаления

ActiveWindow.SelectedSheets.Delete

End Sub

Процедура ExitDoc, расположенная в модуле Module1, завершает работу приложения.

Public Sub ExitDoc()

'Закрытие программы

Application.Quit

End Sub

Перейдем к рассмотрению меню Сервис.

Рассмотрим структуру алгоритма пункта Добавить запись меню Сер­вис.

Процедура Enter, расположенная в модуле Module1, вызывает форму UserForm1, предназначенную для ввода информации о новом рейсе.

Public Sub Enter()

'Открытие формы для ввода данных

UserForm1.Show

End Sub

'UserForm1 отвечает за корректный ввод данных в базу

Private Sub CommandButton1_Click()

Dim i As Integer

'Проверим правильность ввода исходных данных

'Функция IsNumeric проверяет, является ли введенная переменная чис‘лом так как часы и минуты вводятся в виде чисел

If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox6.Text = "" Or IsNumeric(TextBox3.Text) = False _

Or IsNumeric(TextBox4.Text) = False Or IsNu­meric(TextBox5.Text) = False Then

MsgBox "Ошибка ввода.", vbApplicationModal, "Внимание": TextBox1.SetFocus: Exit Sub

End If

i = Application.CountA(Range("A:A")) + 1

'Переменной i присваивается количество непустых за­писей в базе

'Для этого мы воспользовались методом CountA объ­екта ‘Application

'"A:A" означает, что мы ищем непустые записи только в столбце A ‘(номера рейсов),так как в других столбцах непустых записей будет ‘столько же

'Прибавляем единицу, так как следующая ячейка снизу пуста, туда и внесем новую запись

'Объект Worksheets - это лист Excel, с которым мы работаем

'Чтобы указать конкретный лист, с которым ведется работа, ‘необходимо указать номер листа (например, Worksheets(1) или ‘Worksheets("лист1")) или ввести пара­метр ActiveSheet.Name, который указывает имя окрытого листа, где в нашем случае хранится база данных

'Конечно, перед этим необходимо присвоить ActiveSheet.Name имя нашего листа, что сделано в пользо­вательской процедуре NewDoc

Worksheets(ActiveSheet.Name).Cells(i, 1) = i - 1

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

Worksheets(ActiveSheet.Name).Cells(i, 2) = TextBox1

Worksheets(ActiveSheet.Name).Cells(i, 3) = TextBox2.Text

Worksheets(ActiveSheet.Name).Cells(i, 4) = TextBox6.Text +_ " в " + TextBox3.Text + "," + TextBox4.Text

Worksheets(ActiveSheet.Name).Cells(i,5)=CInt(TextBox5.Text)

End Sub

Private Sub CommandButton2_Click()

Unload Me

'Закрытие формы без сохранения в TextBox введенной информации

End Sub

Рис 19 – Внешний вид формы UserForm1

Рис 20 – Результат работы процедуры UserForm1

Процедура Remove, расположенная в модуле Module1, отвечает за удаление выбранного рейса из базы.

Public Sub Remove()

'Удаление записи со смещением строк

Dim a As Integer: Dim i As Integer: Dim k As Integer: Dim p As Integer

'Найдем номер выделенной ячейки, которую вместе со всей строкой хочет удалить пользователь

a = Application.ActiveCell.Row

'Запишем номер рейса данной строки, так как строки могут ‘быть отсортированы не по возрастанию номеров рейсов

p = CInt(Worksheets(ActiveSheet.Name).Cells(a, 1))

'Отсортируем в порядке возрастания номеров рейсов записи в базе для более удобного доступа

Worksheets(ActiveSheet.Name).Range("A2:" & "E" & Application.CountA(Range("A:A"))).Sort Key1:=Worksheets(ActiveSheet.Name).Range(Chr(65) & "2")

Worksheets(ActiveSheet.Name).Range("A1").Select

'Произведем сдвиг на одну строку вверх всех строк, лежащих ‘ниже удаленной

a = p + 1

If a = 1 Then: MsgBox "Заголовок нельзя удалить!", vbCritical, "Ошибка": Exit Sub

For k = a To Application.CountA(Range("A:A")) 'Цикл от текущей до последней строки

For i = 2 To 6

Worksheets(ActiveSheet.Name).Cells(k, i) = Worksheets(ActiveSheet.Name).Cells(k + 1, i)

Worksheets(ActiveSheet.Name).Cells(k + 1, i) = ""

Next i

Next k

Worksheets(ActiveSheet.Name).Cells(Application.CountA(Range("A:_A")), 1) = ""

End Sub

Результат работы процедуры Remove представлен на рисунках 19, 20.

Рис. 21 – Указание рейса, подлежащего удалению

Рис. 22 – Запись удалена

Рассмотрим создание пункта Забронировать билет меню Сервис.

Рис. 23 – Структура разработки пункта Забронировать билет

Public Sub Z_b()

'Открытие формы для бронирования билета с сохранением в файл

UserForm3.Show

End Sub

'UserForm3 предназначена для заказов билетов

Private Sub CommandButton1_Click()

If TextBox1.Text = "" Or IsNumeric(TextBox2.Text) = False Then

MsgBox "Ошибка ввода.", vbApplicationModal, "Внимание": TextBox1.SetFocus: Exit Sub

End If

If Worksheets(ActiveSheet.Name).Cells(CInt(TextBox2) + 1, 5) > 0 Then

'Для корректного поиска номера рейса, билет на который нужно заказать отсортируем сначала наши записи по возрастанию номеров рейсов (по столбцу A)

Worksheets(ActiveSheet.Name).Range("A2:" & "E" & _ Application.CountA(Range("A:A"))).Sort _ Key1:=Worksheets(ActiveSheet.Name).Range(Chr(65) & "2")_

Worksheets(ActiveSheet.Name).Range("A1").Select

Worksheets(ActiveSheet.Name).Cells(CInt(TextBox2) + 1, 5)_ = Worksheets(ActiveSheet.Name).Cells(CInt(TextBox2) + 1, 5) - 1

'Внесем информацию о забронированных билетах в текстовый файл последовательного доступа

Open "file.txt" For Output As #1

Print #1, TextBox1; Tab; "Номер рейса - "; TextBox2

Close #1

Else: MsgBox "Билетов на этот рейс больше нет или нет такого рейса!", , "Нет билетов"

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Рассмотрим создание пункта Сортировка меню Сервис, отвечающего за упорядочивание записей по выбранному критерию.

Рис. 24 – Внешний вид формы UserForm3

Рис. 25 – Структура разработки пункта Сортировка

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

ComdoBox1

Рис. 26 – внешний вид UserForm5 (для хранения критериев сортировки используется объект ComboBox)

Public Sub Sort()

'Открытие формы для сортировки данных

UserForm5.Show

End Sub

'UserForm5 предназначена для ввода критерия сортировки

Private Sub CommandButton1_Click()

Worksheets(ActiveSheet.Name).Range("A2:" & "E" & Application.CountA(Range("A:A"))).Sort Key1:=Worksheets(ActiveSheet.Name).Range(Chr(65 + ComboBox1.ListIndex) & "2")

Worksheets(ActiveSheet.Name).Range("A1").Select

Unload Me

End Sub

Private Sub UserForm_Initialize()

Dim i As Integer

For i = 1 To Application.CountA(Range("1:1"))

'Внесение непустых записей в объект ComboBox1 (всплывающий список) на форме из текущего рабочего листа Excel

ComboBox1.AddItem Worksheets(ActiveSheet.Name).Cells(1, i)

Next i

ComboBox1.ListIndex = -1

'Свойство ListIndex указывает на номер записи, которая будет выведена на объект ComboBox1. В данном случае -1 указывает, что на верхнюю строку ввода не будет выведено ничего (чтобы увидеть все записи, просто нажмите на стрелку, находящуюся справа от строки ввода списка)

End Sub

Рассмотрим пункт Поиск меню Сервис, отвечающего за поиск ближайшего по времени рейса до нужного пункта.

Public Sub Find()

'Открытие формы для поиска данных

UserForm2.Show

End Sub

'UserForm2 предназначена для поиска ближайшего рейса в данный город

Private Sub CommandButton1_Click()

Dim i As Integer: Dim j As Integer: Dim n As Integer

Dim flag As Boolean

If TextBox1.Text = "" Then

MsgBox "Ошибка ввода.", vbApplicationModal, "Внимание": TextBox1.SetFocus: Exit Sub

End If

n = 0

'Метод Sort позволяет отсортировать, по умолчанию, в порядке возрастания все рейсы в базе по их номерам, времени оправления и т.п.

'Для этого выбираем наш рабочий лист с базой данных Worksheets(ActiveSheet.Name)

'Указываем все заполненные ячейки от A2 до E№, где № - номер последней снизу заполненной строки, который мы найдем с помощью метода CountA(A:A)

'Key1 - это параметр сортировки, присвоим ему значение D2

'Это значит, что сортировка будет вестись по столбцу D, то есть по времени отправления

Worksheets(ActiveSheet.Name).Range("A2:" & "E" & Application.CountA(Range("A:A"))).Sort Key1:=Worksheets(ActiveSheet.Name).Range("D2")

'С помощью метода Select устанавливаем курсор на ячейку A1

Worksheets(ActiveSheet.Name).Range("A1").Select

flag = False

For i = 2 To Application.CountA(Range("A:A"))

For j = 2 To 3

If Worksheets(ActiveSheet.Name).Cells(i, j) = TextBox1.Text Then n = CInt(Worksheets(ActiveSheet.Name).Cells(i, 1)): flag = True: Exit For

Next j

If flag Then Exit For

Next i

If n = 0 Then

MsgBox "Необходимый рейс не найден!"

Else: MsgBox " Необходим рейс: №" & n & Chr(13) & Chr(10) & "Время отправления: " _

& Worksheets(ActiveSheet.Name).Cells(n + 1, 4)

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Рис. 27 – Внешний вид формы UserForm2

Процедура AbouProg вызывает форму UserForm7, на которой размещена краткая информация о нашей программе.

Public Sub AboutProg()

'Открытие формы "О программе"

UserForm7.Show

End Sub

'UserForm7 предназначена для вывода краткой информации о программе

Рис. 28– Внешний вид формы UserForm7

На этом создание программы завершено.