Modules

5.69 Modificare da VBA le impostazioni del menu di avvio di un databse Access
  Alessandro Baraldi

Se si memorizzerà in un modulo quanto indicato nel codice VBA che segue sarà poi possibile applicare da codice una sorta di protezione e/o impostazione di avvio. Si può utilizzare lanciando le funzioni Secure o UnSecure qui appresso indicate da un menù sotto password oppure inserendo un controllo nascosto in una maschera.

Con dette due funzioni è possibile modificare in un solo colpo tutte le proprietà del menù di AVVIO compreso ALLOW_BYPASS_KEY ed eventualmente disabilitare/riabilitare la Macro AUTOEXEC.
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
        If docCiclo.Name = "Autoexec" Then                      ' database per verificare la presenza della Macro
                DoCmd.Rename "_Autoexec", acMacro, "Autoexec"   'la rinomina
                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
        If docCiclo.Name = "_Autoexec" Then                     ' database per verificare la presenza della
                DoCmd.Rename "Autoexec", acMacro, "_Autoexec"   ' rinomina
                EnableAutoExec = True
        End If
    Next docCiclo
    Set dbs = Nothing
End Function

Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.