VBAでアプリケーションの位置情報を取得・設定する方法

機能1：アプリケーションの位置情報の登録

概要

起動中のアプリケーションを取得: 現在起動しているアプリケーションのリストを取得します。
アプリケーションの位置情報を取得: 各アプリケーションのウィンドウ位置を取得します。
取得したアプリケーションと位置情報をシートに書き出し: 取得した情報をExcelシートに保存します。

コード

Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Dim appList As Collection

Function EnumWindowProc(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As Long
    Dim windowTitle As String * 256
    If IsWindowVisible(hwnd) Then
        GetWindowText hwnd, windowTitle, Len(windowTitle)
        appList.Add Trim(windowTitle)
    End If
    EnumWindowProc = 1 ' 続行
End Function

Sub RegisterApplicationPositions()
    Set appList = New Collection
    EnumWindows AddressOf EnumWindowProc, 0

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("アプリケーション情報") ' シート名を指定
    ws.Cells.Clear ' シートをクリア

    Dim n As Long
    n = 1
    Dim app As Variant
    For Each app In appList
        Dim rect As RECT
        Dim hwnd As LongPtr
        hwnd = FindWindow(vbNullString, app) ' ウィンドウハンドルを取得
        If hwnd <> 0 Then
            GetWindowRect hwnd, rect
            ws.Cells(n, 1).Value = app ' アプリケーション名
            ws.Cells(n, 2).Value = rect.Left ' 左位置
            ws.Cells(n, 3).Value = rect.Top ' 上位置
            ws.Cells(n, 4).Value = rect.Right ' 右位置
            ws.Cells(n, 5).Value = rect.Bottom ' 下位置
            n = n + 1
        End If
    Next app
End Sub

コードの説明

EnumWindows: 起動中のウィンドウを列挙します。
GetWindowText: 各ウィンドウのタイトルを取得します。
GetWindowRect: 各ウィンドウの位置を取得します。
Excelシートに書き出し: 取得したアプリケーション名と位置情報を指定したシートに書き出します。

機能2：アプリケーションの起動と位置設定

概要

シートに書き出したアプリケーションと位置情報を取得: Excelシートからアプリケーション名と位置情報を取得します。
取得したアプリケーションを起動: アプリケーションを起動します。
起動したアプリケーションを、取得した位置情報の位置に移動: アプリケーションを指定した位置に移動します。

コード

Declare PtrSafe Function Shell Lib "shell32" (ByVal lpPathName As String, ByVal nCmdShow As Long) As Long
Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Sub LaunchAndPositionApplications()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("アプリケーション情報") ' シート名を指定

    Dim n As Long
    n = 1
    Dim appName As String
    Dim leftPos As Long, topPos As Long

    Do While ws.Cells(n, 1).Value <> ""
        appName = ws.Cells(n, 1).Value
        leftPos = ws.Cells(n, 2).Value
        topPos = ws.Cells(n, 3).Value

        ' アプリケーションを起動
        Dim hwnd As LongPtr
        hwnd = Shell(appName, vbNormalFocus)

        ' ウィンドウが起動するまで待機
        Application.Wait Now + TimeValue("00:00:02") ' 2秒待機

        ' ウィンドウハンドルを取得
        hwnd = FindWindow(vbNullString, appName)
        If hwnd <> 0 Then
            ' 位置を設定
            SetWindowPos hwnd, 0, leftPos, topPos, 800, 600, 0 ' 幅800、高さ600で配置
        End If
        n = n + 1
    Loop
End Sub

コードの説明

Shell: アプリケーションを起動します。
FindWindow: 指定したアプリケーションのウィンドウハンドルを取得します。
SetWindowPos: アプリケーションのウィンドウを指定した位置に移動します。

まとめ

機能1では、起動中のアプリケーションの位置情報を取得し、Excelシートに書き出します。
機能2では、シートからアプリケーション名と位置情報を取得し、アプリケーションを起動して指定した位置に配置します。