Программирование на Visual Basic

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