アプリ版:「スタンプのみでお礼する」機能のリリースについて

モードレスダイアログを閉じた時の判断(API)

モードレスダイアログを閉じた時の判断の仕方を教えてください。
お願いします。
コードの例文を載せて頂けると幸いです。

<<詳細>>
具体的にはExcel2003の「検索と置換」ダイアログを使います
(Class:bosa_sdm_XL9 Caption:検索と置換)
下記の動作をVBAで組む為です。

シートの保護解除
 ↓
「検索と置換」ダイアログ起動
 ↓
 ユーザーがダイアログ閉じる※この判断
 ↓
シート保護

A 回答 (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 で停止しましたが )
    • good
    • 0
この回答へのお礼

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の難しさも分りました。
本当に、本当に、本当に、有難う御座いました。

お礼日時:2010/01/07 01:45

今、確認できる環境がありませんので、動作未確認です。


(お正月休みが明けるまで確認できません。)
応答なしや異常終了になる可能性がありますので十分ご注意の上、自己責任において実行してください。


'標準モジュールで記述
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に行かない。

色々と有難う御座います。答えを知りたいですが、諦めるしかないかなと感じています。

補足日時:2010/01/05 16:21
    • good
    • 0

モーダルの置換ダイアログではダメなんでしょうか?


モードレスだと、保護の解除がされている間に好き勝手なことをされる可能性があるので、モーダルの方が良いのではないかと思いますけど。

モーダルのダイアログは

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

補足日時:2009/12/30 20:47
    • good
    • 0

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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!