Данный пример определяет коды клавиш меню для быстрого запуска команд. Например, чтобы вызвать пункт меню "Сервис\Схема данных" достаточно запустить команду: 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