VBA调整OSK.exe窗口的大小

我正在使用Kiosktypes（无鼠标，无键盘）应用程序，用户将数据inputExcel电子表格。 我希望屏幕键盘在每次被调用时都会出现在同一个地方。 osk.exe窗口“记住”它在什么时候被closures，并在下一次打开时重新出现在同一个地方，但在closures之后，osk返回到它的默认位置并覆盖表单。

我需要一种方法来设置osk打开时的位置。 下面是我打开osk的代码。

Dim Shex As Object Dim tgtfile As String Set Shex = CreateObject("Shell.Application") tgtfile = "C:\Windows\System32\osk.exe" Shex.Open (tgtfile) 

我想知道是否有像Shex.Top = 250，或类似的东西。

谢谢！

Answer 1

不幸的是，使用FindWindow API的SetWindowPos API不适用于OSKMainClass("On-Screen Keyboard")我尝试了各种组合，但是一直保持失败。 似乎它不被视为一个正常的窗口。

注意 ：testing了Excel 2010（32位），Windows 8.1 64位（触摸屏是否重要？）中的代码。

这是我试过的代码。 （ 这不起作用 ）

 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 

这是另一种实现你想要的方式。 我正在模拟鼠标点击来完成这项工作。 （ 这工作 ）

 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