Подробное описание решения
Для решения задачи воспользуемся возможностью создания пользовательского меню для нашей базы данных.
Начнем с разработки структуры нашего будущего меню (рисунок 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
![]() |
|


|

Рис 11 – Запуск приложения
Рассмотрим алгоритм процедуры MenuBuilder, необходимой для того, чтобы создать меню пользователя для данного приложения.
Private Sub MenuBuilder()
'Построение пользовательского меню
'Переменная a будет переменной объектного типа CommandBar (Панель инструментов)
Dim a As CommandBar
'Создаем свою панель меню с помощью метода Add в родительском приложении Application
'Для этого обратимся к объекту CommandBars (Панель инструментов) и к его методу Add
'!!!Помните, что обращение к нижележащим объектам производится с помощью разделителя "." (точки)!!!
Set a = Application.CommandBars.Add(Name:="m", Position:=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 Worksheet
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: Columns("B:B").ColumnWidth = 27
Columns("C:C").ColumnWidth = 27: Columns("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 IsNumeric(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, где и будет происходить выбор критерия сорти-ровки.
|
Рис. 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
На этом создание программы завершено.