Создана база, разделена на табличную и интерфейсную части. Интерфейсная часть защищена от Shift'а (при загрузке стартовой формы вызывается процедура, меняющая все пропертя) и сохранена в mde. И все хорошо, если запускается через ярлык, а вот при запуске из Total Commander при нажатом Shift'е нет-нет, да и останется висеть панель Файл Правка Вид Вставка и т.д. Отпускаешь Shift – пропадает панель, но пока не отпустил, там можно в параметрах запуска выставить обратно все галки… :(
Ошибка вылезла не сразу. Запускал много раз, закономерности проскока не выявил. Что я сделал не так?
Код вроде бы стандартный (или что-то проглядел?):
Public Sub SetStartupProperties()
On Error GoTo ErrorHandler
'Вывод окна базы данных
ChangeProperty "StartupShowDBWindow", dbBoolean, False
'Вывод строки состояния
ChangeProperty "StartupShowStatusBar", dbBoolean, False
'Вывод встроенных панелей инструментов
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
'Доступность полной системы встроенных меню MSAccess
ChangeProperty "AllowFullMenus", dbBoolean, False
'Вывод текста программы VB после возникновения в модуле ошибки выполнения
ChangeProperty "AllowBreakIntoCode", dbBoolean, False
'Использование специальных сочетаний клавиш
ChangeProperty "AllowSpecialKeys", dbBoolean, False
'Обход проверки при нажатой клавише Shift
ChangeProperty "AllowBypassKey", dbBoolean, False
Rem ChangeProperty "AllowBypassKey", dbBoolean, True
'Вывод в приложении контекстных меню MSAccess
ChangeProperty "AllowShortcutMenus", dbBoolean, False
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Ошибка №:" & Err.Number & ";Описание:" & Err.Description
Resume ErrorHandlerExit
End Sub
Public Function ChangeProperty(strPropName As String, varType As Variant, varPropValue As Variant) As Integer
Dim prp As DAO.Property
Const conPropNotFoundError = 3270
On Error GoTo ErrorHandler
Set dbs = CurrentDb()
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
ErrorHandlerExit:
Exit Function
ErrorHandler:
If Err = conPropNotFoundError Then ' Свойство не найдено.
Set prp = dbs.CreateProperty(strPropName, varType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Неизвестная ошибка.
ChangeProperty = False
Resume ErrorHandlerExit:
End If
End Function
Public Function AddAppProperty(strPropName As String, varType As Variant, varPropValue As Variant) As Integer
Dim dbs As DAO.Database
Dim prp As DAO.Property
Const conPropNotFoundError = 3270
On Error GoTo ErrorHandler
Set dbs = CurrentDb()
dbs.Properties(strPropName) = varPropValue
AddAppProperty = True
ErrorHandlerExit:
Exit Function
ErrorHandler:
If Err = conPropNotFoundError Then ' Свойство не найдено.
Set prp = dbs.CreateProperty(strPropName, varType, varPropValue)
dbs.Properties.Append prp
Resume
Else
' Неизвестная ошибка.
AddAppProperty = False
Resume ErrorHandler:
End If
End Function