VBA/Excel/Access/Word/Access/Database Properties

Материал из VB Эксперт

Перейти к: навигация, поиск

Содержание

Changing Options

 
Public Sub setOptions()
   With Application
      .SetOption "show status bar", False
      .SetOption "show startup dialog box", False
   End With
End Sub



Database properties: AllowFullMenus, Allowtoolbarchanges

 
Public Sub startupProperties()
   Dim myDatabase As Object
   Set myDatabase = CurrentDb
   myDatabase.Properties("AllowFullMenus") = False
   myDatabase.Properties("Allowtoolbarchanges") = False
 
End Sub



Enumerate the properties of current database

 
Sub EnumDBProperties()
    Dim pty As Property
    Dim strTemp As String
 
    On Error Resume Next
    For Each pty In CurrentDb.Properties
        strTemp = pty.Name & ": "
        strTemp = strTemp & pty.Value
        Debug.Print strTemp
    Next
 
End Sub



reset any values you set

 
Public Sub startupProperties1()
   Dim myDatabase As Object
   Set myDatabase = CurrentDb
   With myDatabase
      .Properties.Delete "AllowFullMenus"
      .Properties.Delete "AllowToolBarChanges"
    End With
    Application.RefreshTitleBar
End Sub



Set new property to database

 
Sub KeepEmOut()
    Dim db As Database
    Dim pty As Property
    On Error GoTo KeepEmOut_Err
    Set db = CurrentDb
    db.Properties("AllowBypassKey").Value = False
KeepEmOut_Exit:
    Exit Sub
KeepEmOut_Err:
    If Err.Number = 3270 Then
        Set pty = db.CreateProperty("AllowBypassKey", dbBoolean, False)
        db.Properties.Append pty
    Else
        Debug.Print Err.Description
        Resume KeepEmOut_Exit
    End If
 
End Sub



Sub KeepEmOut()

 
    Dim db As Database
    Dim pty As Property
    On Error GoTo KeepEmOut_Err
    Set db = CurrentDb
    db.Properties("AllowBypassKey").Value = False
KeepEmOut_Exit:
    Exit Sub
KeepEmOut_Err:
    If Err.Number = 3270 Then       "Error code for "Property not found"...
        "so we"ll create it ourselves
        Set pty = db.CreateProperty("AllowBypassKey", dbBoolean, False)
        db.Properties.Append pty
    Else
        MsgBox Err.Description
        Resume KeepEmOut_Exit
    End If
 
End Sub