- ホーム
- Other
- controlOtherMacroBook
人様の作成したマクロブックのコマンドボタンを逐次キックして自動実行(Msgboxに自動応答して中断防止)
別Workbookのワークシートのコマンドボタンをキックして実行し、表示されたメッセージボックスに自動応答して、閉じます
自作なら、そんなメッセージボックスを表示するなよ、という事ですが、人様の作成したマクロブックを自動操作したい時に役に立ちます。
WindowsAPIのタイマーを使用する事で、モーダルなメッセージボックスのダイアログに情報を渡して操作する事ができます。
もともとはファイル名指定のダイアログにファイル名を与えようとトライしたのですが、
そちらはWindows7の例では相当階層が深くなっていて、思うようにEditのハンドルが取得できないことが多く、停滞しています
'ActiveXコントロールのCommandButtonをSheet1に二個設けたtargetMacroBook.xlsmの
'VBAプロジェクトには保護を掛けて、コードを見られない様にします。(人様作成のブック制御の模擬です)
'このブックのVBAコードを、後述のcontrolOtherMacroBook.xlsmから実行し、
'途中でMsgboxが表示されれば、自動応答して、中断しないようにして、
'連続実行させようという試みです。
'☆ Sheet1モジュール
Private Sub CommandButton1_Click()
MsgBox "処理終了しました"
End Sub
Private Sub CommandButton2_Click()
Dim rc As VbMsgBoxResult
rc = MsgBox("続行しますか?", vbYesNo + vbQuestion)
If rc = vbYes Then
MsgBox "「はい」が選択されました"
Else
MsgBox "「いいえ」が選択されました"
End If
End Sub
'controlOtherMacroBook.xlsmの標準モジュール
'☆ Module1
'事前にgetCommandButtonInfoを実行して、制御したい相手のブックの
'CommandButtonの情報を取得しておきます。TopLeftとかBottomRightセルの番地を取得するのも
'ボタンの特定に役立つでしょう。
'使い方
Sub test1()
Dim sh As Worksheet
Dim wbk As Workbook
Dim hWnd As Long
Set wbk = Application.Workbooks("targetMacroBook.xlsm")
hWnd = Application.hWnd
'ダイアログの自動操作設定
'ダイアログが一回だけ表示されるとき
timerMode = 1 'OKボタンOnly
timerCnt = 0 '動作上限回数指定カウンタリセット 50回×0.1秒 = 5秒を最大にしてある
Call SetTimer(hWnd, MY_TIMER_ID, MY_TIMER_MSEC, AddressOf TimerProc)
wbk.Worksheets("Sheet1").OLEObjects("CommandButton1").Object.Value = True
'ダイアログが複数回表示されるとき
timerCnt = 0 '動作上限回数指定カウンタリセット 50回×0.1秒 = 5秒を最大にしてある
Call SetTimer(hWnd, MY_TIMER_ID, MY_TIMER_MSEC, AddressOf TimerProc2)
wbk.Worksheets("Sheet1").OLEObjects("CommandButton2").Object.Value = True
Call KillTimer(hWnd, MY_TIMER_ID)
End Sub
'普通に実行する場合
'Msgboxに応答する必要があり、実行が途絶えてしまう。
Sub test0()
Dim sh As Worksheet
Dim wbk As Workbook
Dim hWnd As Long
Set wbk = Application.Workbooks("targetMacroBook.xlsm")
wbk.Worksheets("Sheet1").OLEObjects("CommandButton1").Object.Value = True
wbk.Worksheets("Sheet1").OLEObjects("CommandButton2").Object.Value = True
End Sub
'コマンドボタン情報取得
'人様の作成したマクロブック(VBAコード保護)で、自動操作に用いるため
'コマンドボタンの情報を取得するコード
Sub getCommandButtonInfo()
Dim wbk As Workbook
Dim sh As Worksheet
Dim shp As Shape
Dim myOleObj As OLEObject
' Dim myDrawObj As DrawingObject 'こんな型は無かった
' shpに該当するコマンドボタンが入った状態でstopし、Local WindowのDrawingObjectからメンバを確認した
Const toolName As String = "targetMacroBook.xlsm"
Set wbk = Workbooks(toolName)
For Each sh In wbk.Worksheets
For Each shp In sh.Shapes
Select Case shp.Type
Case 12 'msoOLEControlObject
'Control_CommandButton
Set myOleObj = sh.OLEObjects(shp.Name)
If myOleObj.progID = "Forms.CommandButton.1" Then
Debug.Print sh.Name, myOleObj.Name, myOleObj.Object.Caption
'*** 取得した名前からプロシージャの実行 ***
'sh.OLEObjects("CommandButton1").Object.Value = True '名前から、左記の様に実行可能
End If
Case 8 'msoFormControl
'Form_CommandButton
Debug.Print sh.Name, shp.Name, shp.DrawingObject.Caption, shp.DrawingObject.OnAction
'*** 取得した名前からプロシージャの実行 ***
'shp.DrawingObject.Value = 1 '無効、メンバ無し
'Application.Run sh.Shapes("Button 3").DrawingObject.OnAction 'これで実行可能
End Select
Next shp
Next sh
End Sub
'☆ ctrlDialogモジュール
'Windows API宣言'
Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent 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 FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" ( _
ByVal hWndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
'第1引数は、Findwindowで取得したハンドル
'第2引数は、同じクラス名のオブジェクトがあった場合に、最初に見つかった
'子ハンドルを渡すと次の同じ名前の子ハンドルを取得。
'第3引数は、知りたいオブジェクトのクラス名を指定。Spy等で調査しておく。
'第4引数は、ウィンドウ名(vbのフォームに配置するオブジェクトのプロパティの時、キャプション)
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal msg As Long, _
ByVal wParam As Long, ByVal lParam As Any) As Long
'定数定義'
Public Const MY_TIMER_ID As Long = 100001 'タイマーID(任意値)'
Public Const MY_TIMER_MSEC As Long = 100 '0.1秒間隔'
'TimerProcの動作指定変数
Public timerMode As Long
'Timerの動作回数->動作時間上限設定
Const maxCnt As Long = 50
Public timerCnt As Long
'ダイアログ監視タイマーセット
'タイマー用のSubには必ずOn Error Resume Nextを行うこと。でないとエラーが発生したときにEXCELごと終了してしまう。
'と、どこかで読んだが、入れてみても、結局単純なSyntax Errorで容易に暴走してしまうので要注意。
'使い方 TimerProc
' ダイアログが1回しか表示されない場合。一回実行するとタイマー解除。
' timerMode = 1 動作モード指定
' timerMode=1: OKボタン
' timerMode=2: Yes/Noボタン
' 以下、必要に応じて作り込む。
' timerCnt = 0 動作上限回数指定カウンタリセット
' Call SetTimer(hWnd, MY_TIMER_ID, MY_TIMER_MSEC, AddressOf TimerProc)
'使い方 TimerProc2
' ダイアログが複数表示されるとき。タイマー解除は処理終了後に行う様組み込み要
' timerCnt = 0 動作上限回数指定カウンタリセット
' Call SetTimer(hWnd, MY_TIMER_ID, MY_TIMER_MSEC, AddressOf TimerProc2)
' Call KillTimer(hWnd, MY_TIMER_ID)
'Msgbox表示が一回だけの場合
'内部でタイマーを解除している
Public Function TimerProc(ByVal hWnd As Long, ByVal msg As Long, _
ByVal wp As Long, ByVal lp As Long) As Long
Dim dlHWnd As Long
Dim chWnd As Long
On Error Resume Next
timerCnt = timerCnt + 1
'50回実施した場合、タイマーを解除する。
If timerCnt > 50 Then Call KillTimer(hWnd, MY_TIMER_ID)
Select Case wp
Case MY_TIMER_ID
' 'タイマー処理'
Select Case timerMode
Case 1
'Spyでみると、#32770 (ダイアログ)になっている
dlHWnd = FindWindow("#32770", "Microsoft Excel")
If dlHWnd = 0 Then Exit Function
'タイマー再設定停止
Call KillTimer(hWnd, MY_TIMER_ID)
chWnd = FindWindowEx(dlHWnd, 0&, "BUTTON", "OK")
If chWnd > 0 Then
Call SendMessage(chWnd, &H6, 1, 0&) 'ボタンをアクティブにする
Call SendMessage(chWnd, &HF5, 0, 0&) 'ボタンをクリックする
End If
Case 2
dlHWnd = FindWindow("#32770", "Microsoft Excel")
If dlHWnd = 0 Then Exit Function
'タイマー再設定停止
Call KillTimer(hWnd, MY_TIMER_ID)
chWnd = FindWindowEx(dlHWnd, 0&, "BUTTON", "はい(&Y)") '&が必要
If chWnd > 0 Then
Call SendMessage(chWnd, &H6, 1, 0&) 'ボタンをアクティブにする
Call SendMessage(chWnd, &HF5, 0, 0&) 'ボタンをクリックする
End If
Case Else
Call KillTimer(hWnd, MY_TIMER_ID)
End Select
End Select
End Function
'Msgbox表示が複数回の場合
'呼び元のプロシージャでタイマーを解除する必要有り
Public Function TimerProc2(ByVal hWnd As Long, ByVal msg As Long, _
ByVal wp As Long, ByVal lp As Long) As Long
Dim dlHWnd As Long
Dim chWnd As Long
On Error Resume Next
timerCnt = timerCnt + 1
'5秒以上経過したら、タイマー再設定を止める
If timerCnt > 50 Then Call KillTimer(hWnd, MY_TIMER_ID)
Select Case wp
Case MY_TIMER_ID
'タイマー処理'
'Spyでみると、#32770 (ダイアログ)になっている
dlHWnd = FindWindow("#32770", "Microsoft Excel")
' Debug.Print "hWnd:", dlHWnd
If dlHWnd = 0 Then Exit Function
'OKボタンがあればクリック
chWnd = FindWindowEx(dlHWnd, 0&, "BUTTON", "OK")
If chWnd > 0 Then
Call SendMessage(chWnd, &H6, 1, 0&) 'ボタンをアクティブにする
Call SendMessage(chWnd, &HF5, 0, 0&) 'ボタンをクリックする
Else
'OKボタンがないとき、はい(Y)ボタンがあればクリック
chWnd = FindWindowEx(dlHWnd, 0&, "BUTTON", "はい(&Y)") '&が必要
If chWnd > 0 Then
Call SendMessage(chWnd, &H6, 1, 0&) 'ボタンをアクティブにする
Call SendMessage(chWnd, &HF5, 0, 0&) 'ボタンをクリックする
End If
End If
End Select
End Function