[Resolvido]Códigos para bloqueio e desbloqueio da tecla shift

Boa noite, pessoal.

Consultei aqui no Forum sobre bloqueio e desbloqueio da tecla SHIFT. Há quem propõe a conversão do arquivo em ACCDE. Todavia, vi que JPaulo deu uma importante contribuição ao disponibilizar um DB (SecuritMs2007.zip) com códigos que nos permitem bloquear e desbloquear DB "por fora". Inicialmente, essa contribuição destinava-se a DB do Access 2007. Depois JPaulo disse em outra postagem, se entendi bem, que poderia utilizar os códigos para Access 2010, 2013, e este é o meu caso. Entretanto, percebo que alguns botões do formulário do JPaulo não respondem.
Vou começar pelo botão ..., que é para localizar o arquivo no computador.

Código:

Private Sub LocArquivo_Click()
On Error Resume Next
Dim strFilter As String
Dim strInputFileName As String
strFilter = ahtAddFilterItem(strFilter, "(*.accdb)", "*.accdb")
strFilter = ahtAddFilterItem(strFilter, "(*.mde)", "*.mde")
strFilter = ahtAddFilterItem(strFilter, "(*.*)", "*.*")
strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
                DialogTitle:="Selecione o banco de dados ...", _
                Flags:=ahtOFN_HIDEREADONLY)
If strInputFileName <> "" Then Locais = strInputFileName
End Sub

Quando clico no botão ..., nada acontece.

Bom dia pessoal
Fiz alguma bobagem?

Olá Luiz,

A instrução On Error Resume Next ignora quaisquer erros gerados dentro do procedimento, e deve ser usado com muita cautela.

Substitua a instrução por esta:

Código:



Private Sub LocArquivo_Click()
'On Error Resume Next
On Error GoTo trata_erro
Dim strFilter As String
Dim strInputFileName As String
   
    strFilter = ahtAddFilterItem(strFilter, "(*.accdb)", "*.accdb")
    strFilter = ahtAddFilterItem(strFilter, "(*.mde)", "*.mde")
    strFilter = ahtAddFilterItem(strFilter, "(*.*)", "*.*")
    strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
                    DialogTitle:="Selecione o banco de dados ...", _
                    Flags:=ahtOFN_HIDEREADONLY)
    If strInputFileName <> "" Then Locais = strInputFileName
   
    Exit Sub

trata_erro:
    MsgBox "Erro ocorrido: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro"
    Exit Sub
   
End Sub



Assim, vc vai conseguir ver o erro gerado.

Att,

FIM

Alexandre Fim, obrigado por me disponibilizar parte de seu tempo e de seus conhecimentos.
Infelizmente não funcionou.

Estou anexando o arquivo.

Bom dia

Teste este

Bom dia

Se resolveu ...

Encerre o tópico

Assis, bom dia. Obrigado pelo carinho de ter me respondido.

Estava numa área incomunicável. Chegando agora para testar. Daqui a pouco apresento aqui o resultado.

Um grande abraço, mestre.

Assis, adiantou bastante o seu arquivo. Fiz o teste do botões ... (localizar), Sair, Limpar lista e <<< (procura item anterior da lista) e >>> (procura item posterior da lista) estão funcionando direitinho. Mas o botão Activa não deveria estar bloqueando a tecla shift?

Estudei esse código:

Código:

#If VBA7 Then
Private Declare PtrSafe Function apiShowWindow Lib "user32" _
    Alias "ShowWindow" (ByVal hwnd As Long, _
          ByVal nCmdShow As Long) As Long
#Else
Private Declare Function apiShowWindow Lib "user32" _
    Alias "ShowWindow" (ByVal hwnd As Long, _
          ByVal nCmdShow As Long) As Long

Na segunda parte dele não deveria ser também

Código:

Private Declare PtrSafe Function apiShowWindow Lib "user32" _

?

Estou fazendo alguma coisa errada?

Mais uma vez bom dia, obrigado e um grande abraço.

Assis, obrigado mais uma vez.

O cabeção aqui estava fazendo alguma coisa errada. Desculpe-me.

Funcionou direitinho o sistema que me mandou.