| |
みなさんこんにちは。
SendKeysは、NumLockが解除されるといった不具合が多数報告されています。
ユーザーから「数字の入力が出来ないんだけど」といった声があちこちから
聞こえてくるのが想像できます。
私は不具合を体験してからSendKeysの使用をやめました。NumLock解除の回避
方法はありません。sendkeysをやめるか替わりにAPIのkeybd_eventを使用する
方法がよく紹介されていますが、ちょっと違うアプローチで、
タイマーを使ってInputBox表示後に位置を移動する方法を紹介したいと思います。
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHight As Long, _
ByVal bRepain As Long) As Long
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Public Declare Function GetWindowRect Lib "user32.dll" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Sub Test()
Dim obj
'0.3秒後にTimerを発動してInputBoxの位置を移動します。
SetTimer 0&, 0&, 300, AddressOf myTimer
Set obj = Application.InputBox _
(prompt:="該当のdataを選んでちょうだい！", Type:=8)
End Sub
Private Function myTimer(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal SysTime As Long) As Long
Dim Targethwnd&
Dim myRect As RECT
Dim ret&
'※このFunction内にブレークポイントを設置しない事！！ecxelが落ちます。
'値を確認するにはDebug.Printの使用
'Timer中のエラーは、無視をするか正しくエラーをハンドルしなければ
'Excelが落ちます。要注意です。
On Error Resume Next
'フォアグランドにあるウインドウハンドルを取得します。
Targethwnd = GetForegroundWindow()
'InputBoxのウインドウハンドルが取得できたら
If Targethwnd <> 0 Then
'myRectにInputBoxのサイズと位置を格納します。
ret = GetWindowRect(Targethwnd, myRect)
If ret <> 0 Then 'Rectが取得できたら
With myRect
'InputBoxの動かす前の位置を取りあえず書き出してみます。
Debug.Print "Left=" & .Left, "top=" & .Top, _
"right=" & .Right, "bottom=" & .Bottom
'API movewindowでInputBoxを移動します。
MoveWindow Targethwnd, -(.Right - .Left), .Top, _
.Right - .Left, .Bottom - .Top, 1&
'-(.Right - .Left)の値だと画面によっては、
'InputBoxのおしりが見えるはずです。
'-(.Right - .Left)の部分を直接-10000など大きい数字でも
'OKです。
End With
End If
End If
KillTimer 0&, idEvent '必ずTimerを解除します。
End Function
|
|
grok
- 11/2/13(日) 14:49 -
