2011年12月26日月曜日

[ExcelVBA] BringWindowToTop

 
■説明
ウィンドウをZオーダーの先頭に持ってくる関数

■宣言
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
第一引数:ウィンドウのハンドルを指定
戻り値:失敗した時0を返します

■サンプルコード
サンプルでは、電卓アプリを手前に表示するコードです。
FindWindow関数を使ってハンドルを取得しています。
Option Explicit

Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer

Sub SampleCode()
    Dim hwnd As Long
    hwnd = FindWindow("SciCalc", "電卓")
    
    Dim Ret As Integer
    Ret = BringWindowToTop(hwnd)
    
    If Ret = 0 Then MsgBox "アクティブにできませんでした"

    '参考までに戻り値を表示してみる
    Debug.Print Ret '成功したら1が戻ってきた
End Sub


ExcelVBAで同様のことをするには、AppActivate関数を使うとよいですね。
第一引数には、ウィンドウのタイトルかプロセス値のどちらかを指定する必要があります。
存在しない場合エラーとなるため、エラー処理が必要になります。
そのまま終了させるならOn Error
ウィンドウが表示されるまで時間がかかるから
ループで待つのなら、On Error Resume Nextで
処理を止めない等のやり方ですね。
(ループさせる時は、タイムアウトさせる必要もあり)
Option Explicit

Sub SampleCode2()
    On Error Resume Next
    AppActivate ("電卓")
    If Err.Number <> 0 Then MsgBox "アクティブにできませんでした"
    GoTo 0
End Sub


Sub SampleCode3()
    Dim TimeOut As Integer: TimeOut = 5 '存在しない時は、5秒でループを抜ける
    Dim BaseTime As Double: BaseTime = Timer()
    
    On Error Resume Next
    Do
        On Error GoTo 0 'エラー初期化
        AppActivate ("電卓")
        
        'エラーが無ければ抜ける
        If Err.Number = 0 Then Exit Do
        
        'タイムアウトチェック
        If TimeOut < (Timer() - BaseTime) Then
            MsgBox "タイムアウトしました"
            Exit Do
        End If
        
        'Timer関数は0時になると値が0に戻るので
        '0時をまたぐとTimer() - BaseTimeは負の値となり
        'いつまでもタイムアウトしないので負の値だと別に
        'エラー表示する必要がある。
        If (Timer() - BaseTime) < 0 Then
            MsgBox "0時またぎエラー"
            Exit Do
        End If
    Loop
    
End Sub
 

0 件のコメント: