[Resolvido]Abrir teclado virtual no windows 10

Bom dia, pessoal.

Eu já pesquisei e vi que existem tópicos sobre o assunto e já tentei seguir todos, porém, sem sucesso.

Uso em um módulo...

Código:

Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr

E nos forms...

Já usei o código...

Código:

ShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1

Já usei o código...

Código:

ShellExecute 0, vbNullString, "TabTip.exe", vbNullString, "C:\Program Files\Common Files\microsoft shared\ink", 1

Nenhum dos dois funciona a contento. O primeiro não abre de forma alguma, o segundo, te tempos em tempos, abre uma vez e não abre mais.

Espero ajuda dos senhores.

Informações: windows 10 (64 bits) - Access 2010 (32 bits)

Olá Leoni Dias,

Veja tópico abaixo:
https://www.maximoaccess.com/t30755-resolvidomonitor-touchscreen-teclado-virtual-osk-tabtip

Em especial a mensagem nº 11 (e respetivo link)

Abraço

Bom dia, ahteixeira.

Como mostrei nos códigos que tentei, não consegui que nenhum deles funcionasse.

O tentado por Assis não posso usar porque o monitor não é touch e quero usar o teclado normal junto, só usando o teclado virtual quando chamado.

Sobre o link que vc enviou, não entendi se vc quis dizer na mensagem nº. 11, já que no meu pc não existe a pasta "C:\Windows\sysnative\" ou se vc quis dizer que em maquinas com o windows 10 (64 bits) o access 2010 (32 Bits) não abre o teclado virtual.

Poderia tentar também "pressionando" via código as teclas "tecla do logotipo do windows + Ctrl + O" mas não sei como fazer. Já encontrei como mandar as teclas Ctrl e O mas não a tecla do logotipo.

Sigo tentando.

Olá Leoni,

Estou no celular, teste com o exemplo abaixo:
https://www.maximoaccess.com/t30807-abrir-teclado-virtual-tabtip-exe

Se der erro, partilhe a imagem com o erro.

Abraço

Bom dia, ahteixeira.

Verifiquei que usando o comando...

ShellExecute 0, vbNullString, "TabTip.exe", vbNullString, "C:\Program Files\Common Files\microsoft shared\ink", 1

Abre o teclado virtual no canto inferior da tela e não como o osk.exe que fica sobreposto.

Mas, usando para fechar os comandos...


Finalizar ("TabTip.exe")


Sub Finalizar(NomeExe As String)
'---Sub para finalizar o teclado virtual do windows
Dim IDProcesso As Long
IDProcesso = GetProcessIDByEXEName(NomeExe)
If Not IDProcesso = 0 Then ProcessTerminate IDProcesso
End Sub


Function GetProcessIDByEXEName(ByVal EXEName As String) As Long
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim R As Long, lStrtemp As String

hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)

If hSnapShot = -1 Then Exit Function

uProcess.dwSize = Len(uProcess)
R = ProcessFirst(hSnapShot, uProcess)

Do While R

If InStr(UCase(uProcess.szExeFile), UCase(EXEName)) <> 0 Then
GetProcessIDByEXEName = uProcess.th32ProcessID
Call CloseHandle(hSnapShot)
Exit Function
End If

R = ProcessNext(hSnapShot, uProcess)

Loop

Call CloseHandle(hSnapShot)
End Function


Esses comandos acima finalizam a tarefa mas não fecham a janela.


Usei o comando sugerido por jPaulo...

Shell "TaskKill /F /IM ""TabTip.exe"""

Mas não fecham a janela.

Não tem como realizar o "pressionamento" via código as teclas "tecla do logotipo do windows + Ctrl + O" para abrir o OSK.EXE? Já encontrei como mandar as teclas Ctrl e O mas não a tecla do logotipo.

Ola, verifique nas definicoes e depois teste abrir o OSK na linha de comandos

[/url]

Abraco

Bom dia a todos.

A quem possa (acredito que a muitos) interessar, encontrei a solução pesquisando nos sites abaixo:

social.msdn.microsoft.com/Forums/pt-BR/0e3e1eb6-ad12-455c-84e9-b5a78a893ac4/open-on-screen-keyboard-in-windows-10-via-vba

vbforums.com/showthread.php?776981-RESOLVED-Onscreen-Keyboard-No-Workie

------------------------------------------------------------------------------------------

Em um módulo:

Código:

Option Explicit
Dim lngPtr As LongPtr
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr

'Call Wow64DisableWow64FsRedirection prior to calling ShellExecute and Wow64RevertWow64FsRedirection, immediately after.
Private Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As LongPtr) As Boolean
Private Declare PtrSafe Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As LongPtr) As Boolean

Function ShowKeyboard()
Call Wow64DisableWow64FsRedirection(lngPtr)
ShellExecute 0, "open", "osk.exe", "", "", vbNormalFocus
Call Wow64RevertWow64FsRedirection(lngPtr)
End Function

Function HideKeyboard()
Call Wow64DisableWow64FsRedirection(lngPtr)
ShellExecute 0, "open", "tskill", "osk", "", vbHidden
Call Wow64RevertWow64FsRedirection(lngPtr)
End Function

Public Function isWin64bit() As Boolean
 isWin64bit = 0 < Len(Environ("ProgramW6432"))
End Function

--------------------------------------------------------------------------------

No form:

Para abrir:

Código:

If isWin64bit Then
'If Is64bit Then
  ShowKeyboard
  Else
  ShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1
End If

Para fechar:

Código:

If IsWin64bit Then
  HideKeyboard
  Else
  Finalizar ("osk.exe")
End If

Obrigado a vc, ahteixeira.

Olá Leoni, que bom que resolveu!

Obrigado pela partilha do código.

Estive a testar e falta a sub Finalizar, considerando o código da mensagem nº 5 falta ProcessTerminate.
Se poder partilhar o código em falta, ou idealmente um pequeno exemplo, assim fica mais fácil para os membros menos experientes.

Abraço

Bom dia.


Parte anterior no form...

Finalizar ("osk.exe") ou Finalizar ("TabTip.exe")

Código:

Sub Finalizar(NomeExe As String)
'---Sub para finalizar o teclado virtual do windows
Dim IDProcesso As Long
IDProcesso = GetProcessIDByEXEName(NomeExe)
If Not IDProcesso = 0 Then ProcessTerminate IDProcesso
End Sub

---------------------------------------------------------------------------------------

Segue a parte faltante em um módulo...

Código:


Function GetProcessIDByEXEName(ByVal EXEName As String) As Long
   
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim R As Long, lStrtemp As String

hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)

   If hSnapShot = -1 Then Exit Function

uProcess.dwSize = Len(uProcess)
R = ProcessFirst(hSnapShot, uProcess)

   Do While R
   
       If InStr(UCase(uProcess.szExeFile), UCase(EXEName)) <> 0 Then
       GetProcessIDByEXEName = uProcess.th32ProcessID
       Call CloseHandle(hSnapShot)
       Exit Function
       End If
   
   R = ProcessNext(hSnapShot, uProcess)
   
   Loop

Call CloseHandle(hSnapShot)

End Function



Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
   Dim lhwndProcess As Long
   Dim lExitCode As Long
   Dim lRetVal As Long
   Dim lhThisProc As Long
   Dim lhTokenHandle As Long
   Dim tLuid As LUID
   Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
   Dim lBufferNeeded As Long
   
   Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINATE = &H1
   Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
   Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege"
   Const SE_PRIVILEGE_ENABLED = &H2

   On Error Resume Next
   If lHwndWindow Then
       'Get the process ID from the window handle
       lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
   End If
   
   If lProcessID Then
       'Give Kill permissions to this process
       lhThisProc = GetCurrentProcess
       
       OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
       LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
       'Set the number of privileges to be change
       tTokenPriv.PrivilegeCount = 1
       tTokenPriv.TheLuid = tLuid
       tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
       'Enable the kill privilege in the access token of this process
       AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded

       'Open the process to kill
       lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
   
       If lhwndProcess Then
           'Obtained process handle, kill the process
           ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
           Call CloseHandle(lhwndProcess)
       End If
   End If
   On Error GoTo 0
End Function


Ps.: Não testei se necessita usar esse código no windows 10 32 bits. Só testei no windows 10 64 bits.

Se faltar algo, estou a disposição para repassar o código.

Bom dia a ahteixeira.

Realizando testes ontem em um pc com windows 7 32 bits com access 2010 32 bits, verifiquei que o novo código também funciona nesse maquinário.

Então juntei os códigos e exclui outros. Ficou assim para abrir e fechar o teclado virtual:


Para abrir...

Código:

Dim IDProcesso As Long
IDProcesso = GetProcessIDByEXEName("osk.exe") 'Verifica se o teclado já está aberto. Se não, abre.
If IDProcesso = 0 Then ShowKeyboard

Para fechar...

Código:

Dim IDProcesso As Long
IDProcesso = GetProcessIDByEXEName("osk.exe") 'Verifica se o teclado já está fechado. Se não, fecha.
If Not IDProcesso = 0 Then HideKeyboard

Olá Leoni, perfeito!

Obrigado pela partilha o fórum agradece.