Отключение панелей инструментов и прочих глупостей

Источник: msadimsign

Данный код уже вошел в историю, но до сих пор каждый второй новичок спрашивает, как отключить... Вот мы и рассказываем, как.)

Комментарии здесь почти бессмысленны, так как код прозрачен. Получить информацию, что же отключается, можно 1) по названию пункта, 2) нажав на нем F1, после того, как код вставлен в базу.

Обычно вешаю данную функцию на пару пунктов пользовательского меню. Один "Включить" "=DisableToolbars(True)", второй "Выключить" "=DisableToolbars(False)". Пароль спрашивается, чтобы чужие пугались и не лазили. Самый последний пункт убивает тулбар "Строка меню", что негативно отражается на других приложениях, у них тоже исчезает (иногда) строка меню. Так что держите на такой случай кнопку, которой можно все включить.)

Public Function DisableToolbars(flag As Boolean)
If InputBox("Введите пароль!", "Секретная область") <> "qwerty" Then Exit Function

    'ChangeProperty "StartupForm", dbText, "Клиенты"
    ChangeProperty "StartupShowDBWindow", dbBoolean, flag
    ChangeProperty "StartupShowStatusBar", dbBoolean, flag
    ChangeProperty "AllowBuiltinToolbars", dbBoolean, flag
    'ChangeProperty "AllowFullMenus", dbBoolean, flag
    ChangeProperty "AllowShortcutMenus", dbBoolean, flag
    ChangeProperty "AllowBreakIntoCode", dbBoolean, flag
    ChangeProperty "AllowToolbarChanges", dbBoolean, flag
    ChangeProperty "AllowSpecialKeys", dbBoolean, flag
    ChangeProperty "AllowBypassKey", dbBoolean, flag
    CommandBars.Item("Menu Bar").Enabled = flag
End Function

Эта функция приведена в хелпе и комментировать ее не будем. Просто замена свойства базы данных.

Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

Change_Bye:
Exit Function

Change_Err:
    If Err = conPropNotFoundError Then  ' Свойство не найдено.
        Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' Неизвестная ошибка.
        ChangeProperty = False
        Resume Change_Bye
    End If
End Function

Ссылки по теме