Il comando (reperito su internet) disabilita l'utilizzo del tasto Shift all'apertura del DatabaseInserire in un modulo rinominato "Secure" il seguente codice (Secure1 per bloccare i menù, UnSecure per sbloccare i menù).
Option Compare DatabaseOption Explicit
'*********************************************************************' NON MODIFICARE IL NOME DELLA MACRO AUTOEXEC'*********************************************************************
'Questo modulo consente di applicare una sorta di Protezione e/o'impostazione di AVVIO in modo Automatico'Si può utilizzare lanciandola da un Menù sotto Password'oppure inserendo un controllo nascosto in una Form.
'Consente di Modificare in un solo colpo tutte le proprietà'del menù di AVVIO compreso ALLOW_BYPASS_KEY ed eventualmente'la Macro AUTOEXEC.
'Startup propertiesPrivate Const strAppTitle As String = "TITOLO APPLICAZIONE"Private Const strStartUpForm As String = "Menu"Private Const strStartUpMenuBar As String = "mnuPrincipale"Private Const strStartUpShortcutMenuBar As String = vbNullStringPrivate Const strAppIcon As String = vbNullStringPrivate Const blnStartUpShowDBWindow As Boolean = FalsePrivate Const blnStartUpShowStatusBar As Boolean = FalsePrivate Const blnAllowShortcutMenus As Boolean = FalsePrivate Const blnAllowFullMenus As Boolean = FalsePrivate Const blnAllowBuiltInToolbars As Boolean = FalsePrivate Const blnAllowToolbarChanges As Boolean = FalsePrivate Const blnAllowBreakIntoCode As Boolean = FalsePrivate Const blnAllowSpecialKeys As Boolean = FalsePrivate Const blnAllowBypassKey As Boolean = False
Public Function Secure1() On Error Resume Next ' Call ChangeProperty("AppTitle", dbText, strAppTitle) Call ChangeProperty("StartUpForm", dbText, strStartUpForm) ' Call ChangeProperty("StartUpMenuBar", dbText, strStartUpMenuBar) ' Call ChangeProperty("StartupShortcutMenuBar", dbText, strStartUpShortcutMenuBar) ' Call ChangeProperty("AppIcon", dbText, strAppIcon) Call ChangeProperty("StartUpShowDBWindow", dbBoolean, blnStartUpShowDBWindow) Call ChangeProperty("StartUpShowStatusBar", dbBoolean, blnStartUpShowStatusBar) Call ChangeProperty("AllowShortcutMenus", dbBoolean, blnAllowShortcutMenus) Call ChangeProperty("AllowFullMenus", dbBoolean, blnAllowFullMenus) Call ChangeProperty("AllowBuiltInToolbars", dbBoolean, blnAllowBuiltInToolbars) Call ChangeProperty("AllowToolbarChanges", dbBoolean, blnAllowToolbarChanges) 'Call ChangeProperty("AllowBreakIntoCode", dbBoolean, blnAllowBreakIntoCode) Call ChangeProperty("AllowSpecialKeys", dbBoolean, blnAllowSpecialKeys) ' Call ChangeProperty("AllowBypassKey", dbBoolean, blnAllowBypassKey)' If CurrentDb.Containers("Scripts").Documents("$Autoexec").Name = "$Autoexec" Then _ ' EnableAutoExecEnd Function
Public Function UnSecure() ' Call ChangeProperty("AppTitle", dbText, "My Application is UnSecured") Call ChangeProperty("StartUpForm", dbText, vbNullString) 'Call ChangeProperty("StartUpMenuBar", dbText, vbNullString) ' Call ChangeProperty("StartupShortcutMenuBar", dbText, vbNullString) ' Call ChangeProperty("AppIcon", dbText, vbNullString) Call ChangeProperty("StartUpShowDBWindow", dbBoolean, True) Call ChangeProperty("StartUpShowStatusBar", dbBoolean, True) Call ChangeProperty("AllowShortcutMenus", dbBoolean, True) Call ChangeProperty("AllowFullMenus", dbBoolean, True) Call ChangeProperty("AllowBuiltInToolbars", dbBoolean, True) Call ChangeProperty("AllowToolbarChanges", dbBoolean, True) ' Call ChangeProperty("AllowBreakIntoCode", dbBoolean, True) Call ChangeProperty("AllowSpecialKeys", dbBoolean, True) ' Call ChangeProperty("AllowBypassKey", dbBoolean, True)' If CurrentDb.Containers("Scripts").Documents("Autoexec").Name = "Autoexec" Then _ ' DisableAutoExecEnd Function
Private Function ChangeProperty(strPropName As String, _ varPropType As Variant, _ varPropValue As Variant) As Boolean Dim prp As Property On Error GoTo Change_Err If Len(varPropValue) > 0 Then CurrentDb.Properties(strPropName) = varPropValue Else CurrentDb.Properties.Delete strPropName End If ChangeProperty = TrueChange_Bye: Set prp = Nothing Exit FunctionChange_Err: Select Case Err Case 3265 'Item not found in this collection. 'Do Nothing Resume Next Case 3270 'prop not found With CurrentDb Set prp = .CreateProperty(strPropName, varPropType, varPropValue) .Properties.Append prp End With Resume Next Case Else 'unknown error ChangeProperty = False Resume Change_Bye End SelectEnd Function
Public Function SetProperties(strPropName As String, varPropType As Variant, varPropValue As Variant) As IntegerOn Error GoTo Err_SetProperties 'Dim db As Database, prp As Property Dim db As DAO.Database, prp As DAO.Property Set db = CurrentDb db.Properties(strPropName) = varPropValue SetProperties = True Set db = Nothing Exit_SetProperties: Exit Function Err_SetProperties: If Err = 3270 Then 'Property not found Set prp = db.CreateProperty(strPropName, varPropType, varPropValue) db.Properties.Append prp Resume Next Else SetProperties = False MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description Resume Exit_SetProperties End If End Function