| |
▼あまがえる さん：
>このプロシージャの中の中核的なコードは
>
>Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい！",Left:=-10000, Top:=0, Type:=8)
>
>であり、変数「obj」に選択したいデータ行のRangeオブジェクトを代入して、その変数の行番号を取得し、コピーするデータ範囲を決定することにしています。
>
>ここでLeft:=-10000とあるのは、選択元のシート上該当データを探す際にInputBoxメソッドのダイアログボックス自体が邪魔なためであり、画面の表示範囲外にダイアログボックスの位置を指定することで実質的な非表示とし、選択元シート上に表示される破線（非表示ダイアログボックス上のコントロールと連動）のみで選択位置を確認してEnterキー実行し、変数「obj」に目的セルのオブジェクトを代入しています。
>
>さて、Excel2003まではこのコードで問題なく目的の動作を実現できていましたが、2007以降になってLeft:=-10000が無効になり困っています。
>つまりleftの数値に関わらず、画面の同じ中央付近の位置にダイアログボックスがずでんと現れてしまうのです。
>以上の観点からInputBoxメソッドのダイアログボックスの位置の操作方法についてご教示いただければ幸いです。よろしくお願いいたします。
面倒ですが下記の方法で実現できそうですが、取り扱いには注意してください。
Option Explicit
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32.dll" _
() As Long
' フックプロシージャ関係
Private Declare Function SetWindowsHookEx Lib "user32.dll" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" _
(ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WH_CBT = 5
Private Const HCBT_DESTROYWND = 4
Private Const HCBT_ACTIVATE = 5
'サブクラス化関係
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" _
(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 uFlags As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private hHookProc As Long 'フックのハンドル
Private lngLeft As Long
Private lngTop As Long
' CBTフックプロシージャ
Private Function CBTProc(ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim lngRtn As Long
Dim strClass As String
Dim lngWLong As Long
Dim thWnd As Long
Dim lngCtlID As Long
Const Asterisk = 42
Select Case ncode
Case HCBT_ACTIVATE
strClass = String$(13, 0)
GetClassName wParam, strClass, Len(strClass)
If StrComp(strClass, "bosa_sdm_XL9" & vbNullChar, vbBinaryCompare) = 0 Then
' InputBoxを表示
lngRtn = SetWindowPos(wParam, _
0, _
lngLeft, _
lngTop, _
0, _
0, _
SWP_NOSIZE Or _
SWP_NOZORDER Or _
SWP_NOACTIVATE)
End If
Case HCBT_DESTROYWND
Case Is < 0 '次のフック
CBTProc = CallNextHookEx(hHookProc, ncode, wParam, lParam)
Exit Function
End Select
CBTProc = 0
End Function
Public Function AppInputBox(Prompt As String, _
Optional Title, _
Optional Default, _
Optional Left, Optional Top, _
Optional HelpFile, _
Optional HelpContextID, _
Optional objType) As Variant
Dim lngRtn As Long
On Error GoTo InputBox_Close
'フックを設定
hHookProc = SetWindowsHookEx(WH_CBT, _
AddressOf CBTProc, _
0, _
GetCurrentThreadId())
' InputBoxを表示
Set AppInputBox = Application.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, objType)
InputBox_Close:
'フックを解除
lngRtn = UnhookWindowsHookEx(hHookProc)
End Function
' ↓を実行
Sub InputDisp()
Dim rng
lngLeft = -10000
lngTop = 0
Set rng = AppInputBox("該当のdataを選んでちょうだい！", , , , , , , 8)
Debug.Print rng.Address
End Sub
|
|
Yuki
- 11/2/11(金) 11:06 -
