03. Shift - это кнопка, удерживая которую вы сможете открыть базу данных без применения макросов, которые запускаются при открытии базы данных. AllowBypassKey - этот ключ сохраняется в свойствах базы. Используя этот метод (3 пример) можно самому сохранить в свойствах файла (не таблицах) некоторые свои параметры.
'==============================================================
'Название
' Пример 3. Установить защиту
Private Sub butProtOn_Click()
setProtShift False
MsgBox "Защита установлена!" Chr(13) "Перезапустите базу данных!"
End Sub
'==============================================================
'Название
' Пример 3. Снять защиту
Private Sub butProtOff_Click()
setProtShift True
MsgBox "Защита удалена!" Chr(13) "Перезапустите базу данных!"
End Sub
'==============================================================
'Название
' Пример 3. Основная программа
' если myFlag = True - защита установлена,
' если myFlag = False - защита снята
Private Sub setProtShift(myFlag As Boolean)
dbChangeProperty "StartupForm", DB_TEXT, "Автостарт" 'Первая форма
dbChangeProperty "StartupShowDBWindow", DB_BOOLEAN, myFlag 'Главное окно Базы данных
dbChangeProperty "StartupShowStatusBar", DB_BOOLEAN, myFlag 'Нижняя полоска экрана
dbChangeProperty "AllowBuiltinToolbars", DB_BOOLEAN, myFlag 'Панели инструментов
dbChangeProperty "AllowFullMenus", DB_BOOLEAN, myFlag 'Меню таблиц, форм и т.п.
dbChangeProperty "AllowBreakIntoCode", DB_BOOLEAN, myFlag 'Ошибки в модуле
dbChangeProperty "AllowSpecialKeys", DB_BOOLEAN, myFlag 'Специальные ключи (CTRL+BREAK, ...)
dbChangeProperty "AllowBypassKey", DB_BOOLEAN, myFlag 'Ключ Shift
End Sub
'==============================================================
'Название
' Пример 3. Изменить/создать свойство базы данных (см. лекции 2е-2f)
'Параметры:
' strName - имя свойства (Description, Format ...)
' varType - тип свойства (dbText, dbLong ...)
' varValue - значение свойства
'
Function dbChangeProperty(strName As String, varType As Variant, varValue As Variant) As Boolean
Dim prp As Variant, dbs As Database
On Error GoTo 999 'Назначаем переход по ошибке
dbChangeProperty = False 'Возвращаем результат при ошибке
Set dbs = CurrentDb 'Выбираем базу
dbs.Properties(strName) = varValue 'Присваиваем значение
dbChangeProperty = True 'Возвращаем результат
Exit Function 'Выходим из программы
999:
If Err = 3270 Then 'Свойство не найдено
Set prp = dbs.CreateProperty(strName, varType, varValue) 'Создаем свойство
dbs.Properties.Append prp 'Добавляем свойство
Err.Clear 'Очищаем поток от ошибки
Resume Next 'Возвращаемся к следующему оператору
End If
Err.Clear 'Очищаем от незнакомой ошибки
End Function