Vedi se questo può essere quello che chiedi
'*********************************************************************
' 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 properties
Private Const strAppTitle As String = "TITOLO APPLICAZIONE"
Private Const strStartUpForm As String = "PANNELLO PRINCIPALE"
Private Const strStartUpMenuBar As String = "mnuPrincipale"
Private Const strStartUpShortcutMenuBar As String = vbNullString
Private Const strAppIcon As String = vbNullString
Private Const blnStartUpShowDBWindow As Boolean = False
Private Const blnStartUpShowStatusBar As Boolean = False
Private Const blnAllowShortcutMenus As Boolean = False
Private Const blnAllowFullMenus As Boolean = False
Private Const blnAllowBuiltInToolbars As Boolean = False
Private Const blnAllowToolbarChanges As Boolean = False
Private Const blnAllowBreakIntoCode As Boolean = False
Private Const blnAllowSpecialKeys As Boolean = False
Private Const blnAllowBypassKey As Boolean = False
Public Function Secure()
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 _
EnableAutoExec
End 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 _
DisableAutoExec
End 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 = True
Change_Bye:
Set prp = Nothing
Exit Function
Change_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 Select
End Function
Private Function DisableAutoExec() As Boolean
Dim docCiclo As DAO.Document
Dim dbs As DAO.Database
Set dbs = CurrentDb
DisableAutoExec = False
For Each docCiclo In dbs.Containers!Scripts.Documents
'Scorre l'insieme Documents del database per verificare la presenza della Macro
' se esiste la Rinomina
If docCiclo.Name = "Autoexec" Then
DoCmd.Rename "_Autoexec", acMacro, "Autoexec"
DisableAutoExec = True
End If
Next docCiclo
Set dbs = Nothing
End Function
Private Function EnableAutoExec() As Boolean
Dim docCiclo As DAO.Document
Dim dbs As DAO.Database
Set dbs = CurrentDb
EnableAutoExec = False
For Each docCiclo In dbs.Containers!Scripts.Documents
'Scorre l'insieme Documents del database per verificare la presenza della Macro
' se esiste la Rinomina
If docCiclo.Name = "_Autoexec" Then
DoCmd.Rename "Autoexec", acMacro, "_Autoexec"
EnableAutoExec = True
End If
Next docCiclo
Set dbs = Nothing
End Function