- ベストアンサー
モードレスダイアログを閉じた時の判断(API)
モードレスダイアログを閉じた時の判断(API) モードレスダイアログを閉じた時の判断の仕方を教えてください。 お願いします。 コードの例文を載せて頂けると幸いです。 <<詳細>> 具体的にはExcel2003の「検索と置換」ダイアログを使います (Class:bosa_sdm_XL9 Caption:検索と置換) 下記の動作をVBAで組む為です。 シートの保護解除 ↓ 「検索と置換」ダイアログ起動 ↓ ユーザーがダイアログ閉じる※この判断 ↓ シート保護
- みんなの回答 (4)
- 専門家の回答
質問者が選んだベストアンサー
ダイアログが表示される前に次の処理が実行されているとのことですが、 SendKeys "^h",True にするとどうでしょうか? それでもダメなら hwnd=FindWindow(...) の戻り値が≠0になるまでループで hwnd=FindWindow(...) を繰り返し実行するという手もありますが、なんらかの理由でダイアログが表示されなかった場合、無限ループとなり応答なしになってしまうと思います。 ちなみに、私の環境(WindowsXP+Excel2003)では、 SendKeys "^h",True SendKeys "^h" いずれにせよダイアログは表示されませんでした。 仕方がないので、手で「検索と置換」のダイアログを表示させてから実行しましたら、DWL_DLGPROC だとうまくいきませんでしたが、GWL_WNDPROC (-4) に変更するとうまくいきました。ただし、Visual Basic Editor を表示させている状態で実行すると応答がなくなってしまいました。( Control+Break で停止しましたが )
その他の回答 (3)
- tsukasa-12r
- ベストアンサー率65% (358/549)
今、確認できる環境がありませんので、動作未確認です。 (お正月休みが明けるまで確認できません。) 応答なしや異常終了になる可能性がありますので十分ご注意の上、自己責任において実行してください。 '標準モジュールで記述 Public Const DWL_DLGPROC As Long = 4 Public OrgDlgProc As Long Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Const WM_DESTROY As Long = 2 Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Function NewDlgProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If uMsg = WM_DESTORY Then 'ダイアログが閉じられる時 End If NewDlgProc = CallWindowProc(OrgDlgProc, hWnd, uMsg, wParam, lParam) End Function '実行ボタンのモジュール Private Sub CommandButton1_Click() Dim hWnd As Long SendKeys "^h" hWnd = FindWindow("bosa_sdm_XL9", "検索と置換") If hWnd Then OrgDlgProc = GetWindowLong(hWnd, DWL_DLGPROC) If OrgDlgProc Then Call SetWindowLong(hWnd, DWL_DLGPROC, AddressOf NewDlgProc) End If End If End Sub 見やすくするために、全角スペースでインデントしています。 前回の内容と異なっているところがあります。 FindWindowEx でなくても FindWindow で十分なので、FindWindow にしました。 WM_CLOSE は×ボタンやシステムメニューの「閉じる」の時のメッセージなので、WM_DESTROY にしました。
補足
やはり動きませんでした。 SendKeys "^h" でダイアログが立ち上がる前に、後のコードが流れてる可能性が有ります。 マクロ実行する前に「検索と置換」ダイアログを立ち上げても OrgDlgProcにゼロしか入らないので、SetWindowLongに行かない。 色々と有難う御座います。答えを知りたいですが、諦めるしかないかなと感じています。
- tsukasa-12r
- ベストアンサー率65% (358/549)
モーダルの置換ダイアログではダメなんでしょうか? モードレスだと、保護の解除がされている間に好き勝手なことをされる可能性があるので、モーダルの方が良いのではないかと思いますけど。 モーダルのダイアログは Application.Dialogs(xlDialogFormulaReplace).Show で表示できると思います。 ちなみに、APIでモードレスダイアログの終了を検出するには、 1.hwnd=FindWindowEx(0,0,"bosa_sdm_XL9","検索と置換") でダイアログのウインドウハンドルを取得 2.OrgDlgProc=GetWindowLong(hwnd,DWL_DLGPROC) でダイアログプロシージャを取得 3.SetWindowLong(hwnd,DWL_DLGPROC,AddressOf NewDlgProc) で独自のダイアログプロシージャをセット 独自のダイアログプロシージャでは メッセージ=WM_CLOSE で判定し、プロシージャの最後で、CallWindowProcを使用して2.で取得したプロシージャを呼び出す。 という流れになると思います。(あまりおすすめできませんが) このAPIを使用した方法については、「サブクラス化」で検索すると参考になるサイトが見つかるんじゃないかと思います。 ユーザーフォームで置換ダイアログを作成できるなら、APIを使用するよりユーザーフォームでの作成をおすすめします。
補足
回答有難う御座います。 出来れば、実際に動くコードまで教えてください。 宜しくお願いします。 また、ユーザーフォームで作る方が良いと気づいたのですが API分らないので、これを機会にAPIを理解したいと思った次第です。 ヒントを頂いたのですが進みません。自分で考えれたのは下記迄です。 ---標準モジュール--------------------- Option Explicit Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _ ByVal hWnd1 As Long, _ ByVal hWnd2 As Long, _ ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long) As Long Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Const DWL_DLGPROC As Long = 4 -----以下実行ボタンのモジュール------------------- Private Sub CommandButton1_Click() Dim hWnd As Long Dim OrgDlgProc As Long ActiveSheet.Unprotect 'シート保護解除 SendKeys ("^h") '「検索と置換」ダイアログ表示 hWnd = FindWindowEx(0, 0, "bosa_sdm_XL9", "検索と置換") OrgDlgProc = GetWindowLong(hWnd, DWL_DLGPROC) ' 'ここからが分りません ' 'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'シート保護 End Sub
- DreamyCat
- ベストアンサー率56% (295/524)
APIを使ってWindowの有無を確認しようということだと 思いますが、面倒なことをしなくても 下のどちらかのuserformのイベントプロシージャに フラグをたてておけばいいと思います。 Option Explicit Dim Closed_flg As Boolean Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'Closed_flg = True '閉じようとした End Sub Private Sub UserForm_Terminate() Closed_flg = True '閉じられた End Sub
お礼
ANo.3で教えて頂いたコードから下記3箇所を変えたら動きました。 Public Const GWL_WNDPROC As Long = -4 '追加行 OrgDlgProc = GetWindowLong(hWnd, GWL_WNDPROC) 'DWL_DLGPROCをGWL_WNDPROCに変更 Call SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewDlgProc) 'DWL_DLGPROCをGWL_WNDPROCに変更 また、SendKeysは関係なくDWL_DLGPROCを引数にしたせいでした ただ、ダイアログから実際の置換作業を使うことは出来ません。 しかし今回の事でサブクラス化を触りだけでも解かり,APIの難しさも分りました。 本当に、本当に、本当に、有難う御座いました。