LEADERSOFT.ru Разработка на заказ программ и сайтов
Раздел обучения информационным технологиям
Разработка программ на Access
Данный пример определяет коды клавиш меню для быстрого запуска команд. Например, чтобы вызвать пункт меню "Сервис\Схема данных" достаточно запустить команду: CommandBars("Menu Bar").FindControl(, 523, , , True).Execute или CommandBars("Tools").Controls("С&хема данных...").Execute
Свойства продукта

 Microsoft Office: 2000,2002,2003,2007,2010  Архив с файлами: Перейти
 Операционная система: Windows XP,Vista  Применение: Базы данных Access
 Продажа: Купить  Файл исходника: ..\Access\07 Меню\la_menu.mdb
 Язык интерфейса: Русский

   

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 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

Copyright © 2002-2015 ООО Лидер Эксэсс
Сайт работает под управлением: ASP.NET, Access