t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA Excelのウィンドウを最前面に出してから、元の重ね順に戻す方法

今回はExcelのウィンドウを1秒ほど最前面に出してから、元の重ね順に戻すマクロを紹介。
マクロというか、ほとんどAPI処理になってしまった。

何がしたかったかというと、以前作成したスクリーンショット自動貼り付けマクロ(以下)において、貼り付けがうまくいったか確認するために一瞬Excelを最前面に表示させたかった。
thom.hateblo.jp

SetForegroundWindowを使えば楽勝だと思ってたんだけれど、手元の環境で上手く動かない。
プロセスのアタッチ・デタッチとか色々やってみたけどダメ。Excelアイコンが明滅するだけで切り替わらないケースが出てきた。

そこでSetForegroundWindowは諦めてSetWindowPosによる最前面表示を使ってみたところ、イメージした操作ができたので紹介する。

まず宣言部のコード。

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function SetWindowPos Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal uFlags As Long _
    ) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Const GW_HWNDPREV = 3

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long

API関数を5つも使用するハメに。。

それからプロシージャを2つ貼り付けて完了。

Private Sub PopUpWindow()
    '最前面ウィンドウのハンドルをfgw変数に保管
    Dim fgw As Long: fgw = GetForegroundWindow
    
    'Excelよりひとつ手前にあるウインドウのハンドルをbaseWindow変数に保管
    Dim baseWindow As Long: baseWindow = PrevWindow
    
    'Excelを最前面に設定(常に最前面に設定して強制的に最前面に移動させてから、「常に」を外す)
    Call SetWindowPos(Application.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Call SetWindowPos(Application.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    
    DoEvents
    Sleep 1000
    
    'ExcelをbaseWindowの下に戻す
    Call SetWindowPos(Application.hwnd, baseWindow, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    
    'fgwを最前面に戻す
    Call SetWindowPos(fgw, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Call SetWindowPos(fgw, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub

Private Property Get PrevWindow() As Long
    'return用変数retにExcelのウィンドウハンドルを格納
    Dim ret As Long: ret = Application.hwnd
    
    'Excelは複数のウィンドウで構成されるので、
    '別プロセスになるまで手前へ手前へとretにハンドルを格納しつづける。
    '例えばExcelのひとつ手前にメモ帳が表示されていても、
    '単にGetWindow(Application.hwnd, GW_HWNDPREV)と書くだけではまだExcelの内部ウィンドウがヒットしてしまうので、
    '別プロセスが現れるまでループさせる必要がある。
    Do While GetWindowThreadProcessId(Application.hwnd, 0) = GetWindowThreadProcessId(ret, 0)
        ret = GetWindow(ret, GW_HWNDPREV)
    Loop

    PrevWindow = ret
End Property

ウィンドウハンドルとはウィンドウを識別するためのIDで、実体は整数である。

PopUpWindowを呼び出すと、約1秒間Excelが最前面になり、それから元の位置に戻る。
PopUpWindowはPublicにして他モジュールから呼べるようにしても良い。

APIを使ったので紹介がてらコメントを書いているけれど、手元のコードにはほとんどコメントは入れてない。
 本来コードがやってることをコメントでそのまま書くのは冗長なので。
 ただしPrevWindowの長いコメントは意図を補完しているので残しておこうと思う。

以上

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。