[ExcelVBA] BringWindowToTop

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] WindowsAPI一覧

　

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

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

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

view plainprint?

1. Option Explicit  
2.   
3. Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long  
4. Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _  
5. (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer  
6.   
7. Sub SampleCode()  
8.     Dim hwnd As Long  
9.     hwnd = FindWindow("SciCalc", "電卓")  
10.       
11.     Dim Ret As Integer  
12.     Ret = BringWindowToTop(hwnd)  
13.       
14.     If Ret = 0 Then MsgBox "アクティブにできませんでした"  
15.   
16.     '参考までに戻り値を表示してみる  
17.     Debug.Print Ret '成功したら１が戻ってきた  
18. End Sub  

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 '成功したら１が戻ってきた
End Sub

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

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode2()  
4.     On Error Resume Next  
5.     AppActivate ("電卓")  
6.     If Err.Number <> 0 Then MsgBox "アクティブにできませんでした"  
7.     GoTo 0  
8. End Sub  
9.   
10.   
11. Sub SampleCode3()  
12.     Dim TimeOut As Integer: TimeOut = 5 '存在しない時は、5秒でループを抜ける  
13.     Dim BaseTime As Double: BaseTime = Timer()  
14.       
15.     On Error Resume Next  
16.     Do  
17.         On Error GoTo 0 'エラー初期化  
18.         AppActivate ("電卓")  
19.           
20.         'エラーが無ければ抜ける  
21.         If Err.Number = 0 Then Exit Do  
22.           
23.         'タイムアウトチェック  
24.         If TimeOut < (Timer() - BaseTime) Then  
25.             MsgBox "タイムアウトしました"  
26.             Exit Do  
27.         End If  
28.           
29.         'Timer関数は0時になると値が0に戻るので  
30.         '0時をまたぐとTimer() - BaseTimeは負の値となり  
31.         'いつまでもタイムアウトしないので負の値だと別に  
32.         'エラー表示する必要がある。  
33.         If (Timer() - BaseTime) < 0 Then  
34.             MsgBox "0時またぎエラー"  
35.             Exit Do  
36.         End If  
37.     Loop  
38.       
39. End Sub  

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

　

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] WindowsAPI一覧