[Resolvido]Travar a tecla shift no banco

Boa tarde amigos!
Alguem tem um esquema para travar a tecla shift no banco de dados? onde somente o administrador do banco consegue destravar?

Abraço a todos e grato!

veja no repositório de exemplos que não falta lá disso

Segue o codigo conforme solicitado.


Private Sub btnBloqueia_Click()
If MsgBox("ESTA AÇÃO IRÁ BLOQUEAR A UTILIZAÇÃO DA TECLA SHIFT, IMPOSSIBILITANDO O ACESSO MESMO PARA MANUTENÇÃO. CONFIRMA O BLOQUEIO?", vbQuestion + vbYesNo, "CONTROLE DE MODIFICAÇÕES - ADMINISTRAÇÃO SISTEMA") = vbYes Then

'Trava a tecla shift (veja módulo Shift)
AlterarPropriedade "AllowBypassKey", dbBoolean, False
'Oculta objetos marcados como ocultos na janela banco de dados
Application.SetOption "Mostrar Objetos Ocultos", False

MsgBox "SISTEMA BLOQUEADO COM SUCESSO! TECLA SHIFT FOI DESBILITADA!", vbExclamation, "CONTROLE DE MODIFICAÇÕES - ADMINISTRAÇÃO"

End If
End Sub

Private Sub btnDesbloquear_Click()
If MsgBox("ESTA AÇÃO IRÁ DESBLOQUEAR O SISTEMA E PERMITIRÁ A UTILIZAÇÃO DA TECLA SHIFT, POSSIBILITANDO O ACESSO PARA MANUTENÇÃO. CONFIRMA O BLOQUEIO?", vbQuestion + vbYesNo, "CONTROLE DE MODIFICAÇÕES - ADMINISTRAÇÃO SISTEMA") = vbYes Then

'Libera a tecla shift (veja módulo Shift)
AlterarPropriedade "AllowBypassKey", dbBoolean, True

MsgBox "ATENÇÃO: SISTEMA DESBLOQUEADO COM SUCESSO! TECLA SHIFT FOI HABILITADA!", vbCritical, "CONTROLE DE MODIFICAÇÕES - ADMINISTRAÇÃO"

End If
End Sub




' Função para bloquear a tecla Shift na abertura.
' A lógica é a seguinte: Criarei uum formulário "Administrador" onde terei 2 botões, o de "Bloquear" e o de "Desbloquear".
' Logicamente, serão os botões que comandarão esta tarefa.
' Sempre que enviar uma nova aplicação para os usuários, devo disponibilizar a mesma Bloqueada!

Function AlterarPropriedade(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer

Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
AlterarPropriedade = True

Change_Bye:
Exit Function

Change_Err:
If err = conPropNotFoundError Then ' Propriedade não localizada.

Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Erro desconhecido.
AlterarPropriedade = False
Resume Change_Bye
End If
End Function

Maravilha mais um caso resolvido!
Obrigado amigos!

Obrigado pelo retorno o fórum agradece