access2010 AllowBypasskey Tool

アプリケーションパーツでツール
モーダルにしとけばいいんだな

Option Compare Database
Option Explicit

Private Sub Form_Load()
    Me.RecordSelectors = False
    Me.NavigationButtons = False
    SettglAllowBypasskey
End Sub

Private Sub cmdDelAllowBypassKey_Click()
On Error Resume Next
    CurrentDb.Properties.Delete "AllowBypassKey"
    SettglAllowBypasskey
End Sub

Private Sub tglAllowBypasskey_Click()
    With Me.tglAllowBypasskey
        SetBypassProperty .Value
        .Caption = "AllowBypasskey = " & CBool(.Value)
    End With
End Sub

Private Sub cmdClose_Click()
    DoCmd.Close
End Sub

Private Sub SetBypassProperty(fBool As Boolean)
Const DB_Boolean As Long = 1
    ChangeProperty "AllowBypassKey", DB_Boolean, fBool
End Sub

Private Sub SettglAllowBypasskey()
On Error GoTo ErrHnd
    With Me.tglAllowBypasskey
        .Value = CurrentDb.Properties("AllowBypassKey")
        .Caption = "AllowBypasskey = " & .Value
    End With
Exit Sub
ErrHnd:
    If Err.Number = 3270 Then
        Me.tglAllowBypasskey.Caption = "未設定"
        Me.tglAllowBypasskey = True
    Else
        MsgBox Err.Number
    End If
End Sub

Private Function ChangeProperty(strPropName As String, _
                                varPropType As Variant, _
                                varPropValue As Variant) As Integer

    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

Change_Bye:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then ' プロパティが見つからないエラーの場合。
        Set prp = dbs.CreateProperty(strPropName, _
                                     varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' 不明なエラーの場合。
        ChangeProperty = False
        Resume Change_Bye
    End If
End Function