他のプログラムにボタン押下のメッセージ(SendMessage)を送る

これもまたよくある例だけど。

やってることはSettingButtonsを実行すると，対象ウィンドウからボタンを見つけてきて，
ボタン名とハンドルを紐付けconfのコレクションに保存し，pushButton(ボタン名)を実行すると
そのボタンが押下するってだけ。

ただし，同じボタン名がある場合はひとつのボタンのハンドルしか紐付けられない。
（紐付け時にどのボタンのハンドルと紐付けるか選択するようになっている）

え。同じボタン名でも両方それぞれ押下できるようにしろって？
面倒だからやだｗ

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, _
                                                                      ByVal cap As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, _
                                                                            ByVal lpString As String, _
                                                                            ByVal cch As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, _
                                                        ByVal lpEnumFunc As Long, _
                                                        ByVal lParam As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
                                                                        ByVal wMsg As Long, _
                                                                        ByVal wParam As Long, _
                                                                        ByVal lParam As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, _
                                                                        ByVal wMsg As Long, _
                                                                        ByVal wParam As Long, _
                                                                        ByVal lParam As Long) As Long
Private Const BUFFER_SIZE As Long = 255
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const TARGET_WINDOW_TITLE = "電卓"

Private conf As New Collection

' Window サイズ用の型
Type RECT
    left As Long ' 四角形の左上隅の x 座標を指定します。
    top As Long ' 四角形の左上隅の y 座標を指定します。
    right As Long ' 四角形の右下隅の x 座標を指定します。
    bottom As Long ' 四角形の右下隅の y 座標を指定します。
End Type

' コレクションからオブジェクトを取り出す。存在しない場合はNothingを返す
Private Function getObjectFrom(c As Collection, key) As Object
    Set getObjectFrom = Nothing
    On Error Resume Next
    Set getObjectFrom = c.Item(key)
    On Error GoTo 0
End Function


Private Function searchButtons(ByVal hWnd As Long, ByVal buttons As Collection) As Long
    ' ループを繰り返す場合はTrue
    searchButtons = True
    
    ' クラス名を取得
    Dim strClassName As String ' * 255
    strClassName = String(255, vbNullChar)
    GetClassName hWnd, strClassName, Len(strClassName)
    strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1))
    If strClassName <> "Button" Then
        Exit Function
    End If

    ' キャプション(ボタン名)を取得
    Dim strCaption As String
    strCaption = String$(BUFFER_SIZE, vbNullChar) ' 予め領域を確保
    GetWindowText hWnd, strCaption, Len(strCaption) ' エラーは無視
    strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1)) ' 末尾のごみを削除
            
    ' ボタンのウィンドウ内の位置取得
    Dim p_hWnd As Long
    p_hWnd = GetParent(hWnd) ' ウィンドウ(親)のハンドル取得。エラー(p_hWnd = NULL)は無視
    
    Dim rc As Long
    Dim p_lpRect As RECT, lpRect As RECT
    rc = GetWindowRect(p_hWnd, p_lpRect) ' ウィンドウ(親)の位置取得。エラー(rc = 0)は無視
    rc = GetWindowRect(hWnd, lpRect) ' ボタンの位置取得。エラー(rc = 0)は無視
    
    ' ウィンドウ内の位置を求める
    With lpRect
        .top = .top - p_lpRect.top
        .left = .left - p_lpRect.left
        .bottom = .bottom - p_lpRect.top
        .right = .right - p_lpRect.left
    End With
    
    ' Debug.Print hWnd, strCaption, lpRect.left, lpRect.top, lpRect.right, lpRect.bottom, rc
    
    
    ' ボタン名ごとにボタンのリストを格納
    Dim btn_list As Collection
    Set btn_list = getObjectFrom(buttons, strCaption) ' ボタンのリスト取得
    If btn_list Is Nothing Then ' まだない場合は追加する
        Set btn_list = New Collection
        buttons.Add btn_list, strCaption
    End If
    
    ' ボタンの情報
    Dim btn As VButton
    Set btn = New VButton
    btn.hWnd = hWnd
    btn.name = strCaption
    btn.top = lpRect.top
    btn.left = lpRect.left
    
    ' 見つけたボタンをコレクションに追加
    btn_list.Add btn
    
End Function

Private Sub getButtons(ByRef buttons As Collection)
    ' クリア
    Do While buttons.Count > 0
        buttons.Remove 1
    Loop
    
    ' タイトル名からウィンドウを探す
    Dim hWindow As Long
    hWindow = FindWindow(vbNullString, TARGET_WINDOW_TITLE)
    If hWindow = 0 Then
        Call MsgBox(TARGET_WINDOW_TITLE & "ウィンドウが見つかりません。" & vbLf & _
                    "起動してから実行してください。")
        Exit Sub
    End If
        
    ' 対象ウィンドウのボタンを列挙し，使用するボタンのハンドルと名称を取得する
    Call EnumChildWindows(hWindow, AddressOf searchButtons, ObjPtr(buttons))
End Sub

Public Sub pushButton(name As String, Optional useCache As Boolean = False)
    ' 設定済みであれば，ボタンを押す
    Dim btn As VButton
    Set btn = getObjectFrom(conf, name)
    If btn Is Nothing Then
        Call MsgBox(name & "ボタンは設定されていません。" & vbLf & _
                    "設定してから使用してください", vbCritical)
        Exit Sub
    End If
    
    ' 設定値にあるハンドラを再利用する
    If useCache Then
        If IsWindow(btn.hWnd) Then ' ハンドラが有効化？
            Call SendMessage(btn.hWnd, WM_LBUTTONDOWN, 0, 0)
            Call SendMessage(btn.hWnd, WM_LBUTTONUP, 0, 0)
            Exit Sub
        End If
    End If
    
    ' 設定の位置情報に合致するハンドラを再取得する
    Dim buttons As Collection ' ボタンの入れ物を用意
    Set buttons = New Collection
    
    Call getButtons(buttons)
    
    ' ボタン情報を再取得
    Dim list As Collection
    Set list = getObjectFrom(buttons, name)
    If list Is Nothing Then
        Call MsgBox(name & "ボタンが見つかりませんでした。" & vbLf & _
                    "アプリが起動していることを確認した上，再設定してください", vbCritical)
        Exit Sub
    End If
    
    ' 設定の位置情報とマッチするか？
    Dim isMatch As Boolean
    isMatch = False
    Dim obj As Variant
    For Each obj In list
        If obj.left = btn.left And obj.top = btn.top Then
            isMatch = True
            conf.Remove name
            conf.Add obj, name
            Set btn = obj
        End If
    Next
    
    ' 設定の位置情報とマッチしない？？？
    If Not isMatch Then
        Call MsgBox("設定または起動しているアプリが不正です。" & vbLf & _
                    "再度アプリを起動し再設定してください。", vbCritical)
        Exit Sub
    End If
    
    ' ボタンを押す
    Call SendMessage(btn.hWnd, WM_LBUTTONDOWN, 0, 0)
    Call SendMessage(btn.hWnd, WM_LBUTTONUP, 0, 0)
    
End Sub

Public Sub SettingButtons()
    Dim ret As Long
    ret = MsgBox("ボタンとマクロの対応付けを行ないます。" & vbLf & _
                 "現在の設定はクリアされます。継続しますか？", vbYesNo + vbQuestion)
    If ret <> vbYes Then
        Exit Sub
    End If
    
    Call MsgBox("対象アプリが起動していない場合は起動してください。" & vbLf & _
                "OKをクリックすると対象のウィンドウのボタンを押下します。" & vbLf & _
                vbLf & _
                "期待動作をした場合   ⇒ 「はい」" & vbLf & _
                "期待動作をしない場合 ⇒ 「いいえ」" & vbLf & _
                "設定を中断する場合   ⇒ 「キャンセル」")
    
    ' 設定をクリア
    Do While conf.Count > 0
        conf.Remove 1
    Loop
    
    Dim buttons As Collection ' ボタンの入れ物を用意
    Set buttons = New Collection
    
    Call getButtons(buttons)
    
    Dim list As Variant
    For Each list In buttons
        Dim btn As Variant
        
        Dim isSet As Boolean
        isSet = False
        Dim name As String
        name = list(1).name
        
        Do
            For Each btn In list
                Call SendMessage(btn.hWnd, WM_LBUTTONDOWN, 0, 0)
                Call SendMessage(btn.hWnd, WM_LBUTTONUP, 0, 0)
                'Debug.Print btn.name, btn.hWnd, btn.left, btn.top, IsWindow(btn.hWnd)
                ret = MsgBox("[" & name & "]ボタンを押下しました。期待動作をしましたか？" & _
                             vbLf & "しなければ別の[" & name & "]ボタンを押下します。", _
                             vbYesNoCancel + vbQuestion)
                If ret = vbYes Then
                    isSet = True
                    conf.Add btn, btn.name
                    Exit For
                ElseIf ret = vbCancel Then
                    Call MsgBox("設定を中断します。", vbCritical)
                    Exit Sub
                End If
            Next
            
            If isSet Then
                Exit Do
            End If
            
            ret = MsgBox("[" & name & "]ボタンは他にありませんでした。" & vbLf & _
                         "もう一度確認しますか？", vbYesNoCancel + vbQuestion)
            If ret = vbNo Then
                Call MsgBox("[" & name & "]ボタンはスキップし，次のボタンを設定します", vbInformation)
                Exit Do
            ElseIf ret = vbCancel Then
                Call MsgBox("設定を中断します。", vbCritical)
                Exit Sub
            End If
        Loop
        
    Next
    
    Call MsgBox("設定が完了しました")
    'dumpConfig
End Sub


Private Sub dumpConfig()
    Debug.Print "Dump Config"
    Dim o As Variant
    For Each o In conf
        Debug.Print o.name, o.hWnd, o.left, o.top, IsWindow(o.hWnd)
    Next
End Sub

Private Sub listupButtons()
    Dim buttons As Collection ' ボタンの入れ物を用意
    Set buttons = New Collection
    
    getButtons buttons
    
    Dim list As Variant
    For Each list In buttons
        Dim o As Variant
        For Each o In list
            Debug.Print o.name, o.hWnd, o.left, o.top, IsWindow(o.hWnd)
        Next
    Next
    
End Sub

あ，途中に出てくるVButtonってのはこんなクラスモジュールです。これだけですｗ

Option Explicit

Public hWnd As Long
Public name As String
Public top As Long
Public left As Long

Public Sub Class_Initialize()
    hWnd = 0
    name = ""
    top = 0
    left = 0
End Sub

参考：

• 他ウィンドウのボタンをSendMessageで押したいのですが・・・: DOBON.NETプログラミング掲示板過去ログ
• ウィンドウの列挙
• 列挙のマクロ ( ソフトウェア ) - Note - Yahoo!ブログ
• http://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_t02.htm
• http://homepage1.nifty.com/MADIA/vc/vc_bbs/200601/200601_06010004.html