[VBA]ウインドウリサイズマクロの実装

まえおき

最近、自分の仕事の効率が低いことを鑑みて、何が原因かを考えてみると、ウィンドウのリサイズに時間をかけすぎていることに気が付いた。

まるで、両手で土をかき分けてタイムカプセルを掘り起こすがごとく、ウィンドウA ~ Dをあっちにこっちに移動させ、埋もれたウィンドウEを発掘する。
次にまたウィンドウAが必要になるが、特に考えもなしに移動させているので、これまた発掘に時間がかかる。

ちなみに、Win + Tabについても普段から利用はしているが、どうにも

時間に追われるとWin + Tabを使うのを忘れてしまう
Win + Tabで表示されるウィンドウの一覧から目的のウィンドウを探すのが苦手。例えば、ブラウザは大体1つしかないのでアイコンで見つけられるのだが、エクセルは基本4 ~ 5程度開いており、ファイル名から判別するのに時間を要してしまう。
Win + Tabでウィンドウを開いても、そのウィンドウが画面上のどこに表示されているかについても数秒見つけるのに時間がかかる場合がある。

というような傾向にあるようだ（他人事）

ゆえに、常に指定のウィンドウがどこに配置されているかを気にすることなく、欲しいタイミングで表示させる必要があるわけだ。

ちなみに、悲しいかなこの”迷子になる”のはブラウザのタブにおいても同様に発生する。

つくりたいもの

・ウィンドウをリサイズする機能の実装。
・ただし、シーンごとに画面に配置しておきたいウィンドウは違ってくるし、その組み合わせも異なる。ゆえに複数パターンに対応できる必要がある。

動作

マクロに任意のショートカットキー(ex. Ctrl + Shift + Qなど)を割り当てて、WindowMultiArrange.arrange()を呼び出す。
数秒間は数字キーを受け付けるため、その間に1 ~ 9の数字キーを押下する。
数字キーを押したら、それに対応するコンフィグを呼び出す。

例えば、数字の1であれば、「テンプレートメモ帳」「人口変動*.pdf」「イントラネットリンク集.xlsm」の3つのファイルをリサイズする。x, y, width, heightは画面全体を(0.0 ~ 1.0)とみなしての座標指定である。
例えば「テンプレートメモ帳」は画面の左上に、「人口変動*.pdf」は左下に配置される。
細かいが数字が0.0から始まってないのは単なる設定ミスである。

数字の2を押下すれば、レイアウト2に定義したファイル群がリサイズされるという具合である。
レイアウトは1 ~ 9まで定義可能。

名前の*はワイルドカードなので、ファイル末尾に日付が入るような場合でも、日付手前までを指定しておけば、定義を修正する必要はない。

画面イメージ

ソースコード

' Class : Keyboard
Option Explicit

' 指定した全てのキーが入力されているか
' keys : キーID(vbKeyXX)のコレクション
Public Function IsKeysPushed(keys As Collection) As Boolean
    
    ' キーが押下されたを表すステータス
    Const KEY_STATE_PRESSED As Integer = &H8000
                    
    Dim pushed_flag As Boolean
    pushed_flag = True
    Dim key As Variant
    For Each key In keys
        ' キーが押下されていない場合、フラグを折る
        If ((GetAsyncKeyState(key) And KEY_STATE_PRESSED) = 0) Then
            pushed_flag = False
            Exit For
        End If
    Next
        
    If (pushed_flag) Then
        IsKeysPushed = True
        Exit Function
    End If

    IsKeysPushed = False
End Function

' 指定した全てのキー + 任意の数字キーが入力されているか
' keys : キーID(vbKeyXX)のコレクション
' return: -1: 押されていない
'         1 ~ 9: 指定の数字が押された
'
' ex keys = [ctrl + shift] ⇒ ctrl + shift + (1 ~ 9)の3キーが押されているか
'
Public Function IsKeysWithNumberPushed(keys As Collection) As Long
                
    ' 引数のキーコレクションに数字キーを加える
    Dim no As Long
    For no = 1 To 9
        Dim keysWithNo As Collection
        Set keysWithNo = New Collection
        Dim key As Variant
        For Each key In keys
            Call keysWithNo.Add(key)
        Next
        keysWithNo.Add (vbKey1 + no - 1)
        
        If (IsKeysPushed(keysWithNo)) Then
            IsKeysWithNumberPushed = no
            Exit Function
        End If
    Next
        
    IsKeysWithNumberPushed = -1
End Function

' Class : WindowArranger
Option Explicit

' ウィンドウをリサイズする
' ディスプレイの左上を0.0, 右下を1.0とし、サイズを指定する
Public Sub Resize(hWnd As Long, xRate As Double, yRate As Double, widthRate As Double, heightRate As Double)
    
    ' ディスプレイサイズを取得する
    Dim displayWidth As Long
    Dim displayHeight As Long
    displayWidth = GetSystemMetrics(0)
    displayHeight = GetSystemMetrics(1)

    ' リサイズする
    Dim x As Long
    Dim y As Long
    Dim width As Long
    Dim height As Long
    x = displayWidth * xRate
    y = displayHeight * yRate
    width = displayWidth * widthRate
    height = displayHeight * heightRate
    Call MoveWindow(hWnd, x, y, width, height, 0)
End Sub

' Class : WindowHandlerSelector
Option Explicit

' 指定したキャプションのウィンドウハンドルを取得する
Public Function GetWindowHandleByCaption(regexpCaption As String) As Long
    
    ' ウィンドウの一覧を取得する
    Dim hWnds As Collection
    Dim captions As Collection
    Dim classNames As Collection
    Call GetWindowList(hWnds, captions, classNames)
    
    ' 合致するウィンドウがあれば、そのウィンドウハンドルを返却する
    Dim i As Long
    For i = 1 To captions.count
        If (captions.Item(i) Like regexpCaption) Then
            'And classNames.Item(i) = className) Then
            GetWindowHandleByCaption = hWnds.Item(i)
            Exit Function
        End If
    Next
    GetWindowHandleByCaption = -1
End Function

' ウィンドウの一覧を取得する
Private Sub GetWindowList(hWnds As Collection, captions As Collection, classNames As Collection)

    ' 取得ウィンドウの相対位置
    Const GW_HWNDLAST As Long = 1
    Const GW_HWNDNEXT As Long = 2

    Set hWnds = New Collection
    Set captions = New Collection
    Set classNames = New Collection
    
    Dim hWnd As Long
    hWnd = FindWindow(vbNullString, vbNullString)
    Do
        ' ウィンドウが表示されているか
        If (IsWindowVisible(hWnd)) Then
            Call hWnds.Add(hWnd)
        
            ' ウィンドウのキャプションを取得する
            Dim fixedCaption As String * 500
            Dim caption As String
            Call GetWindowText(hWnd, fixedCaption, Len(fixedCaption))
            caption = Left(fixedCaption, InStr(fixedCaption, vbNullChar) - 1)
            Call captions.Add(caption)
            Debug.Print caption
                                                
            ' ウィンドウのクラスを取得する
            Dim fixedClassName As String * 500
            Dim className As String
            Call GetClassName(hWnd, fixedClassName, Len(fixedClassName))
            className = Left(fixedClassName, InStr(fixedClassName, vbNullChar) - 1)
            Call classNames.Add(className)
            Debug.Print className
        End If
        
        ' 次のウィンドウハンドルを取得する
        hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)

    ' 終端のウィンドウに到達するまで
    Loop Until hWnd = GetNextWindow(hWnd, GW_HWNDLAST)
End Sub

' WindowMultiArrange
Option Explicit

Public Sub Arrange()
    On Error Resume Next
    Application.StatusBar = "数字キーの入力を受け付けます"
    On Error GoTo 0

    ' 数字キー：1 ~ 9の入力待ち
    Dim inputNo As Long
    inputNo = ObserveInputKey()

    If (inputNo = -1) Then
        On Error Resume Next
        Application.StatusBar = "リサイズを受け付けましたが、タイムアウトしました"
        On Error GoTo 0
        Exit Sub
    End If
        
    Dim hWndSelector As WindowHandleSelector
    Set hWndSelector = New WindowHandleSelector
    
    Dim windowArranger As windowArranger
    Set windowArranger = New windowArranger
    
    ' 数字に対応する定義の座標を取得
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Config")
    
    Dim r As Range
    Set r = sh.Range("B:B").Find(What:="■レイアウト" & inputNo, LookAt:=xlWhole)
    Set r = r.Offset(2, 0)
    
    ' リストに定義されたアプリケーションの数だけループ
    
    Do While r.Value <> ""
    
        ' リストから情報を取得
        Dim captionName As String
        Dim posX As Double
        Dim posY As Double
        Dim width As Double
        Dim height As Double
            
        captionName = r.Offset(0, 0).Value
        posX = CDbl(r.Offset(0, 1).Value)
        posY = CDbl(r.Offset(0, 2).Value)
        width = CDbl(r.Offset(0, 3).Value)
        height = CDbl(r.Offset(0, 4).Value)
        Set r = r.Offset(1, 0)
        
        ' ウィンドウハンドルを取得する
        Dim hWnd As Long
        hWnd = hWndSelector.GetWindowHandleByCaption(captionName)
        
        ' ウィンドウをリサイズする
        If (hWnd <> -1) Then
            Call windowArranger.Resize(hWnd, posX, posY, width, height)
        Else
            Debug.Print (captionName & "のウィンドウは見つかりませんでした。")
        End If
    Loop
    
    On Error Resume Next
    Application.StatusBar = "リサイズが完了しました"
    On Error GoTo 0
End Sub

' キー入力状況を監視する
Private Function ObserveInputKey() As Long

    ' タイムアウト秒(ms)
    Const TIMEOUT_MS As Long = 5000
        
    Dim keys As Collection
    Set keys = New Collection
    
    Dim keyboard As keyboard
    Set keyboard = New keyboard
    
    ' 指定時間、キー押下状態を監視する
    Dim begin_time As Long
    begin_time = Timer()
    Do While (Timer() - begin_time) * 1000 < TIMEOUT_MS
        DoEvents
        Call Sleep(10)
        
        Dim result As Long
        result = keyboard.IsKeysWithNumberPushed(keys)
        If (result <> -1) Then
           ObserveInputKey = result
           Exit Function
        End If
    Loop
    
    ObserveInputKey = -1
End Function

' 標準モジュール WInAPI64Define
Option Explicit

#If Win64 Then

'------------------------------------------------------------------------
' ウィンドウ
'------------------------------------------------------------------------
' ウィンドウハンドルを取得する
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

' 検索時、次のウィンドウハンドルを取得する
Public Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
    (ByVal hWnd As Long, ByVal wFlag As Long) As Long
 
 ' ウィンドウの可視状態を取得する
Public Declare PtrSafe Function IsWindowVisible Lib "user32" _
    (ByVal hWnd As Long) As Long

' ウィンドウのキャプションを取得する
Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  
' ウィンドウのクラス名を取得する
Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

' 最前面のウィンドウを取得する
Public Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long

' ウィンドウの位置を移動する
Public Declare PtrSafe Function MoveWindow Lib "user32" _
    (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

' ディスプレイサイズ(解像度)を取得する
Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

'------------------------------------------------------------------------
' キーボード
'------------------------------------------------------------------------
' キーボードの入力状況を取得する
Public Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer

'------------------------------------------------------------------------
' Sleep
'------------------------------------------------------------------------
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

さいごに

VBAの採用について

VBAの場合、エクセルが活性状態でないとキーを受け付けないため、エクセルをクリックしてからショートカットキーを押すという若干の手間がある。

キーを監視してウィンドウのリサイズをするのであれば、C#でもできる。
実際C#出の実装も検討したし、ネット上にサンプルコードも公開されているが、C#自体経験がほぼ皆無であることもあり、実装に使われている技術が高いと感じたため、妥協案としてVBAを採用した。

果たして効率化されるだろうか

正味、慣れるまでにはかなりの時間を要すると思う。
おそらく、「どのウィンドウがどのキーに対応していただろうか？」という具合に。

また、いったんはエクセルをクリックして、という工程がどの程度手間に感じられるか。

Win + 数字キーでタスクバーに配置されたエクセルファイルを開くこともできるが、それすらもＷin＋Tabの下位互換と感じる可能性がある。

もしかしたら、このマクロはそのままお蔵入りになる可能性もある。

えんすく！

まったりプログラミング