VBA調整OSK.exe窗口的大小

Question

我正在使用用戶將數據輸入到Excel電子表格的Kiosk類型（無鼠標，無鍵盤）應用程序。我希望屏幕鍵盤在每次被調用時出現在同一個地方。 osk.exe窗口'記住'它被關閉時的位置，並在下一次打開時重新出現在同一個地方，但在關閉之後，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

不幸的是SetWindowPos API與FindWindow API不工作OSKMainClass("On-Screen Keyboard")我嘗試過各種組合，但它保持失敗。看起來像它不被視爲一個正常的窗口。

注意：經測試，在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