VBA to resize the OSK.exe window

Question

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!

Which OS are you using? Win 7 or Win 8? – Siddharth Rout May 24 '15 at 10:46 — Siddharth Rout, May 24 '15 at 10:46

Siddharth Rout · Accepted Answer · 2015-05-24T11:45:17.317

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

VBA to resize the OSK.exe window

1 Answers1