Ответить на сообщение
Вернуться к теме
Вы отвечаете на сообщение:
ник: Скорп где-то в дебрях инета нашел вот такую штуку
'Функция создания трех контекстых меню, 'и прописывания их формам и отчетам. 'Запускать единоразово в новой базе Option Compare Database Option Explicit Const msoBarPopup = 5 Public Sub CreateMyPopupMenu() On Error GoTo er Dim i As Integer, a As Object, aName As String, n As String '--------------- MyFormFull ------------------------------------------- aName = "MyFormFull" On Error Resume Next Set a = CommandBars(aName) If Err.Number = 0 Then a.Delete Err.Clear: On Error GoTo er Set a = CommandBars.Add(aName, msoBarPopup) a.Controls.Add 1, 640 '&Фильтр по выделенному a.Controls.Add 1, 3017 'Искл&ючить выделенное a.Controls.Add 2, 2863 'Фи&льтр для: a.Controls.Add 1, 605 '&Удалить фильтр a.Controls.Add 1, 21 '&Вырезать a.Controls.Add 1, 19 '&Копировать a.Controls.Add 1, 22 'Вст&авить a.Controls.Add 1, 210 'Сортировка по во&зрастанию a.Controls.Add 1, 211 'Сортировка по у&быванию a.Controls(5).BeginGroup = True 'перед &Вырезать a.Controls(8).BeginGroup = True 'перед Сортировка по во&зрастанию '--------------- MyFormSmall ------------------------------------------- aName = "MyFormSmall" On Error Resume Next Set a = CommandBars(aName) If Err.Number = 0 Then a.Delete Err.Clear: On Error GoTo er Set a = CommandBars.Add(aName, msoBarPopup) a.Controls.Add 1, 21 '&Вырезать a.Controls.Add 1, 19 '&Копировать a.Controls.Add 1, 22 'Вст&авить '--------------- MyReport ------------------------------------------- aName = "MyReport" On Error Resume Next Set a = CommandBars(aName) If Err.Number = 0 Then a.Delete Err.Clear: On Error GoTo er Set a = CommandBars.Add(aName, msoBarPopup) a.Controls.Add 4, 1733 'Мас&штаб: a.Controls.Add 1, 5 '&Одна страница a.Controls.Add 16, 177 '&Несколько страниц a.Controls.Add 1, 247 'Пара&метры страницы... a.Controls.Add 1, 4 '&Печать... a.Controls(4).BeginGroup = True 'перед Пара&метры страницы... '--------------- приклеить меню к формам ------------------------------ For i = 0 To CurrentDb.Containers("Forms").Documents.Count - 1 n = CurrentDb.Containers("Forms").Documents(i).Name DoCmd.OpenForm n, acDesign, , , , acHidden SysCmd acSysCmdSetStatus, "Form: " & n DoEvents If Forms(n).ShortcutMenu Then If Forms(n).DefaultView = 0 Then Forms(n).ShortcutMenuBar = "MyFormSmall" Else Forms(n).ShortcutMenuBar = "MyFormFull" End If End If DoCmd.Close acForm, n, acSaveYes Next '--------------- приклеить меню к отчетам ----------------------------- For i = 0 To CurrentDb.Containers("Reports").Documents.Count - 1 n = CurrentDb.Containers("Reports").Documents(i).Name SysCmd acSysCmdSetStatus, "Report: " & n DoEvents DoCmd.OpenReport n, acViewDesign, , , acHidden Reports(n).ShortcutMenuBar = "MyReport" DoCmd.Close acReport, n, acSaveYes Next '---------------------------------------------------------------------- SysCmd acSysCmdClearStatus Exit Sub er: MsgBox Err.Description, vbCritical, Err.Number End Sub
Ваше имя:
Пароль:
Сообщение:
Прикрепить:
Для вставки смайлов в текст щелкните по значку.