Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14049 / 76733 ←次へ | 前へ→

【68184】Re:InputBoxメソッドのD.Box位置について
発言  Yuki  - 11/2/11(金) 11:06 -

引用なし
パスワード
   ▼あまがえる さん:
>このプロシージャの中の中核的なコードは
>
>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

1 hits

【68181】InputBoxメソッドのD.Box位置について あまがえる 11/2/10(木) 10:33 質問
【68184】Re:InputBoxメソッドのD.Box位置について Yuki 11/2/11(金) 11:06 発言
【68185】Re:InputBoxメソッドのD.Box位置について Yuki 11/2/11(金) 11:10 発言
【68187】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/11(金) 18:20 お礼
【68188】Re:InputBoxメソッドのD.Box位置について kanabun 11/2/11(金) 19:29 発言
【68192】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/12(土) 4:55 お礼
【68193】Re:InputBoxメソッドのD.Box位置について kanabun 11/2/12(土) 10:45 発言
【68194】Re:InputBoxメソッドのD.Box位置について とおりすがり 11/2/12(土) 10:47 回答
【68195】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/13(日) 8:40 お礼
【68196】Re:InputBoxメソッドのD.Box位置について UO3 11/2/13(日) 12:19 発言
【68197】Re:InputBoxメソッドのD.Box位置について grok 11/2/13(日) 14:49 発言
【68200】Re:InputBoxメソッドのD.Box位置について grok 11/2/13(日) 17:18 発言
【68201】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/13(日) 23:28 発言
【68202】Re:InputBoxメソッドのD.Box位置について UO3 11/2/14(月) 9:16 発言
【68206】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/14(月) 21:17 発言
【68207】Re:InputBoxメソッドのD.Box位置について grok 11/2/14(月) 22:10 発言
【68208】Re:InputBoxメソッドのD.Box位置について UO3 11/2/15(火) 0:46 発言
【68210】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/15(火) 6:11 発言
【68211】Re:InputBoxメソッドのD.Box位置について UO3 11/2/15(火) 6:34 発言
【68212】Re:InputBoxメソッドのD.Box位置について よろずや 11/2/15(火) 6:48 発言
【68213】Re:InputBoxメソッドのD.Box位置について UO3 11/2/15(火) 9:27 発言
【68225】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/15(火) 23:57 発言
【68249】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/17(木) 14:15 お礼

14049 / 76733 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free