При разработке интерфейса Вам может потребоваться погасить или отобразить некоторые кнопки меню. Этот пример показывает, как можно это сделать.
'==============================================================
' Вставить кнопку
Private Sub butInsert_Click()
Dim But As CommandBarButton 'Mso9.dll
On Error GoTo 999
Set But = Application.CommandBars("Мое меню").Controls.Add(msoControlButton)
With But
.BeginGroup = True 'Начинаем размещение с начала группы
.FaceId = 1 'Устанавливаем код кнопки
.Style = msoButtonCaption 'Выбираем стандартный тип
.Caption = "Привет" 'Называем кнопку
.TooltipText = "Мой привет всем!" 'Всплывающая подсказка
.OnAction = "=msgbox(""Привет всем!"")" 'Моя программа
End With
Exit Sub
999:
Err.Clear
End Sub
'==============================================================
' Удалить кнопку
Private Sub butDelete_Click()
On Error GoTo 999
Application.CommandBars("Мое меню").Controls("Привет").Delete
999:
Err.Clear
End Sub
Данный пример определяет коды клавиш меню для быстрого запуска команд. Например, чтобы вызвать пункт меню "Сервис\Схема данных" достаточно запустить команду: CommandBars("Menu Bar").FindControl(, 523, , , True).Execute или CommandBars("Tools").Controls("С&хема данных...").Execute
Private Sub myBar_AfterUpdate()
' Гасим все меню
On Error Resume Next
Dim cbr As CommandBar
For Each cbr In Application.CommandBars
If cbr.Visible Then cbr.Visible = False
Next
Err.Clear
On Error GoTo 999
' Удаляем все из базы данных
Dim dbs As Database
Set dbs = CurrentDb 'Выбор базы данных
dbs.Execute "DELETE * FROM [Пример 05]" 'Удаляем все записи
Me.myControlsBar.Requery
' Находим панель
Set cbr = Application.CommandBars(Me.myBar.Value) ' Выбираем меню
cbr.Visible = True
' Просматриваем панель
Dim cbc As CommandBarControl
For Each cbc In cbr.Controls ' Просматриваем все кнопки
putControlsBar cbc.Parent.Name, cbc ' Сохраняем кнопку
Next
' Перерисовываем форму
Me.myControlsBar.Requery
Me.txtMsg.Visible = False ' Гасим сообщение
Exit Sub
999:
MsgBox Err.Description
Err.Clear
End Sub
Private Function putControlsBar(strParent As String, obj As Object)
Dim cbc As CommandBarControl, s As String
If TypeOf obj Is CommandBarPopup Then
' Меню. Сохраняем каждую кнопку меню
For Each cbc In obj.CommandBar.Controls
s = strParent "\" cbc.Parent.Name
putControlsBar s, cbc
Next cbc
Else
' Кнопка. Добавляем ее в таблицу
InsertString strParent, obj.Caption, obj.ID
End If
End Function
'==============================================================
' Вставляем строку в базу данных
Private Function InsertString(strParent As String, strCaption As String, longID As Long)
Dim s As String, dbs As Database, strCommand As String
On Error Resume Next
Set dbs = CurrentDb 'Выбор базы данных
strCommand = "CommandBars(""""Menu Bar"""").FindControl(, " longID ", , , True).Execute"
s = "INSERT INTO [Пример 05] ( Parent, Name, ID, Command ) SELECT """ _
strParent """ AS Parent, """ _
strCaption """ AS Name," _
longID " AS ID, """ _
strCommand """ AS Command;"
dbs.Execute s 'Добавляем в таблицу код кнопки
Debug.Print s
Err.Clear
' Сообщаем о работе программы
DoEvents
Me.txtMsg.Visible = Not Me.txtMsg.Visible ' Сообщение
End Function
'==============================================================
' Отобразить схему базы данных
' (выберите код кнопки и запустите программу)
Private Sub butTools_Click()
Dim cbc As CommandBarControl
' 1 вариант. Запуск по названию
'CommandBars("Tools").Controls("Схема данных...").Execute
' 2 вариант. Поиск по коду и проверка для запуска
'Set cbc = CommandBars("Menu Bar").FindControl(ID:=523, Recursive:=True)
'If cbc.Visible Then cbc.Execute
' 3 вариант. Поиск и запуск по коду
CommandBars("Menu Bar").FindControl(, 523, , , True).Execute
End Sub
При разработке интерфейса Вам может потребоваться погасить или отобразить меню. Этот пример показывает, как можно это сделать.
Private Sub butProgram1_Click()
Me.MenuBar = "Мое меню"
If Me.butProgram1.Caption = "Отобразить меню" Then
DoCmd.ShowToolbar Me.MenuBar, acToolbarYes
Me.butProgram1.Caption = "Погасить меню"
Else
DoCmd.ShowToolbar Me.MenuBar, acToolbarNo
Me.butProgram1.Caption = "Отобразить меню"
End If
End Sub
При разработке интерфейса Вам может потребоваться использовать правую кнопку мыши для вызова контекстного меню. Как это сделать программным способом смотрите в этом разделе.
Dim WithEvents myCombo As CommandBarComboBox ' Обработка событий
Const strMenu As String = "Правая кнопка"
Private Sub Form_Open(Cancel As Integer)
' Определяем название
On Error Resume Next
CommandBars.Item(strMenu).Delete
Err.Clear
' Создаем панель меню
On Error GoTo 999
Dim myBar As CommandBar
Set myBar = CommandBars.Add(strMenu, msoBarPopup, , False)
' Добавляем 1 кнопку
Dim But As CommandBarButton
Set But = myBar.Controls.Add(msoControlButton)
With But
.Style = msoButtonCaption ' Выбираем стандартный тип
.FaceId = 1 ' Устанавливаем код кнопки
.Caption = "Кнопка 1" ' Называем кнопку
.OnAction = "=msgBox('Привет!')" ' Определяем программу
End With
' Создаем список в меню
Set myCombo = myBar.Controls.Add(msoControlDropdown, , 1)
With myCombo
.BeginGroup = True
.Caption = "Cписок: "
.Style = msoComboLabel
.AddItem "Строка 1"
.AddItem "Строка 2"
.ListIndex = 2 ' Устанавливаем 2 вариант
.DropDownWidth = -1 ' Выбираем ширину по самому длинному
End With
' Добавляем кнопки меню из других панелей
' (для нахождения кодов смотрите пример 05)
'
With CommandBars("Menu Bar")
.FindControl(, 523, , , True).Copy myBar ' Схема данных
.FindControl(, 210, , , True).Copy myBar ' Сортировка по возрастанию
.FindControl(, 211, , , True).Copy myBar ' Сортировка по убыванию
.FindControl(, 19, , , True).Copy myBar ' Копировать в буфер
End With
' Просмотр данных из текущей позиции
' myBar.ShowPopup
Exit Sub
999:
MsgBox Err.Description
End Sub
'==============================================================
' Отключение
Private Sub butOld_Enter()
Me.ShortcutMenuBar = ""
End Sub
'==============================================================
' Включение меню
Private Sub butNew_Enter()
Me.ShortcutMenuBar = strMenu
End Sub
'==============================================================
' Включение меню
Private Sub myCombo_Change(ByVal ctrl As CommandBarComboBox)
MsgBox "Текст: " ctrl.Text
End Sub