Bloqueo de Shift (III)

Este bloqueo de la tecla Shift está pensado con la finalidad de evitar modificaciones en la estructura de tablas, consultas, formularios, etc. impidiendo el acceso a la base de datos en modo diseño.
Parte III. Comprobación del estado de la tecla Shift.


**********************************************************
Public Function ComprobarShift()
    On Error GoTo errComprobarShift
    Dim db As Database
    Dim prop As Property
    Const conPropNotFound = 3270
    Set db = CurrentDb()
    If db.Properties("AllowByPassKey") = True Then
        ComprobarShift = True
    Else
        ComprobarShift = False
    End If
Exit Function
errComprobarShift:
    If Err = conPropNotFound Then
    Set prop = db.CreateProperty("AllowByPassKey", dbBoolean, True)
        db.Properties.Append prop
        ComprobarShift = True
        Resume Next
    Else
        MsgBox "La función 'ap_DisableShift' no se completó satisfactoriamente."
        Exit Function
    End If
End Function
**********************************************************

Bloqueo de Shift (II)

Este bloqueo de la tecla Shift está pensado con la finalidad de evitar modificaciones en la estructura de tablas, consultas, formularios, etc. impidiendo el acceso a la base de datos en modo diseño. Parte II. Desbloqueo de Shift.
**********************************************************
Function ap_EnableShift()
    On Error GoTo errEnableShift
    Dim db As Database
    Dim prop As Property
    Const conPropNotFound = 3270


    Set db = CurrentDb()


    db.Properties("AllowByPassKey") = True
Exit Function
errEnableShift:
    If Err = conPropNotFound Then
    Set prop = db.CreateProperty("AllowByPassKey", _
        dbBoolean, True)
        db.Properties.Append prop
        Resume Next
    Else
        MsgBox "La función 'ap_DisableShift' no se completó satisfactoriamente."
        Exit Function
    End If
End Function
**********************************************************

Bloqueo de Shift (I)

Este bloqueo de la tecla Shift está pensado con la finalidad de evitar modificaciones en la estructura de tablas, consultas, formularios, etc. impidiendo el acceso a la base de datos en modo diseño.
Parte I. Bloqueo de Shift.


**********************************************************
Function ap_DisableShift()
    On Error GoTo errDisableShift
    Dim db As Database
    Dim prop As Property
    Const conPropNotFound = 3270
    If MsgBox("Está a punto de deshabilitar el uso de SHIFT en el acceso a esta aplicación. Pulse ACEPTAR para proseguir.", vbExclamation + vbOKCancel, "Bloqueo de Shift") = vbCancel Then
       Exit Function
    Else
        Set db = CurrentDb()
        db.Properties("AllowByPassKey") = False
    End If
    'function successful
Exit Function
errDisableShift:
    If Err = conPropNotFound Then
    Set prop = db.CreateProperty("AllowByPassKey", _
        dbBoolean, False)
        db.Properties.Append prop
        Resume Next
    Else
        MsgBox "La función 'ap_DisableShift' no se completó satisfactoriamente."
        Exit Function
    End If
End Function
**********************************************************

Bloqueo de Shift (IV)

Este bloqueo de la tecla Shift está pensado con la finalidad de evitar modificaciones en la estructura de tablas, consultas, formularios, etc. impidiendo el acceso a la base de datos en modo diseño.
Parte IV. Ejecución de código para bloquear/desbloquear la tecla Shift.


Tras hacer clic en el lugar establecido por el programador (botón, fondo de formulario, etiqueta oculta, etc.) se ejecutará el siguiente código, que no hace más que comprobar el estado de la tecla Shift. Si está bloqueada porque se haya realizado esta orden con aterioridad, ejecutará el desbloqueo (ap_EnableShift), y en caso contrario ejecutará el bloqueo (ap_DisableShift).


**********************************************************
If ComprobarShift = True Then
    'Me.Cmd_Shift.Caption = "Habilitar Shift"
    ap_DisableShift
Else
    'Me.Cmd_Shift.Caption = "Deshabilitar Shift"
    ap_EnableShift
End If
**********************************************************