I am working on a Kiosk-type (no mouse, no keyboard) application where users enter data into an Excel spreadsheet. I would like to have the on-screen keyboard appear in the same place every time it gets called. The osk.exe window 'remembers' where it is when it gets closed and will re-appear in the same place the next time it is opened, but after a shutdown the osk returns to its default location and covers up the form.
I need a way to set the position of the osk whenever it is opened. Below is the code I have for opening the osk.
Dim Shex As Object
Dim tgtfile As String
Set Shex = CreateObject("Shell.Application")
tgtfile = "C:\Windows\System32\osk.exe"
Shex.Open (tgtfile)
I'm wondering if there is something like Shex.Top = 250, or something like that.
Thanks!
Unfortunately SetWindowPos API with FindWindow API doesn't work for OSKMainClass("On-Screen Keyboard") I tried various combinations but it kept on failing. Seems like it is not treated as a normal window.
Note: Tested the code in Excel 2010 (32 bit), Windows 8.1 64 Bit (Touch Screen if it matters?)
This is the code that I tried. (THIS DOESN'T WORK)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1
Sub Sample()
Dim Ret As Long, retval As Long
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
Shex.Open ("C:\Windows\System32\osk.exe")
Wait 1
Ret = FindWindow("OSKMainClass", "On-Screen Keyboard")
If Ret <> 0 Then
'Msgbox "On-Screen Keyboard Window Found"
retval = SetWindowPos(Ret, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE)
DoEvents
If retval = False Then MsgBox "Unable to move Window"
End If
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Here is another way to achieve what you want. I am simulating the mouse click to do the job. (THIS WORKS)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Integer, ByVal Y As Integer) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim pos As RECT
Sub Sample()
Dim Ret As Long, retval As Long
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
Shex.Open ("C:\Windows\System32\osk.exe")
Wait 1
Ret = FindWindow("OSKMainClass", "On-Screen Keyboard")
If Ret <> 0 Then
GetWindowRect Ret, pos
'~~> Get the co-ordinates of some point in titlebar
cur_x = pos.Left + 10
cur_y = pos.Top + 10
'~~> New Destination (Top Left Corner of Desktop)
dest_x = 0
dest_y = 0
'~~> Move the cursor to a place in titlebar
SetCursorPos cur_x, cur_y
Wait 1 '<~~ Wait 1 second
'~~> Press the left mouse button on the Title Bar
mouse_event MOUSEEVENTF_LEFTDOWN, cur_x, cur_y, 0, 0
'~> Set the new destination. Take cursor there
SetCursorPos dest_x, dest_y
'~~> Press the left mouse button again to release it
mouse_event MOUSEEVENTF_LEFTUP, dest_x, dest_y, 0, 0
Wait 1
MsgBox "done"
End If
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub