VBA: Win32API GetSystemMetrics活用

Tech

本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。

VBAでWin32API GetSystemMetricsを活用したOffice自動化

背景と要件

Microsoft OfficeアプリケーションにおけるVBA（Visual Basic for Applications）は、定型業務の自動化やカスタム機能の追加に広く利用されています。しかし、VBAの標準機能だけでは、ユーザーのシステム環境に関する詳細な情報を取得し、それに基づいてアプリケーションの動作を最適化することは困難な場合があります。

ここで登場するのが、Windowsが提供するネイティブなAPIであるWin32 APIです。特にGetSystemMetrics関数は、システムの様々な設定や寸法に関する情報を取得するための強力なツールです。例えば、画面解像度、仮想画面のサイズと位置、マウスの有無や左右ボタンの設定など、多岐にわたるシステム情報を取得できます。 、VBAからGetSystemMetricsを呼び出し、その情報を活用してExcelやAccessといったOfficeアプリケーションのUIを動的に調整したり、ユーザー環境に応じた処理を実行したりする方法を解説します。外部ライブラリに依存せず、Win32 APIを直接利用することで、Officeソリューションの柔軟性と堅牢性を高めることを目指します。

設計

GetSystemMetricsは、指定されたインデックスに基づいてシステムメトリックの値を返す関数です。VBAからこのAPIを呼び出すためには、まずDeclare PtrSafeステートメントを使用して関数を宣言し、利用するシステムメトリックの定数を定義する必要があります。

取得したシステム情報は、Officeアプリケーションのウィンドウ配置、フォームのサイズ調整、レポートの印刷範囲最適化、あるいはユーザーの操作環境（マウスの左右ボタン設定など）に合わせた機能提供に活用できます。

処理フロー

VBAでGetSystemMetricsを活用する際の基本的な処理フローは以下の通りです。

graph TD
    A["VBAプロシージャ実行"] --> B{"システム環境情報の取得要否？"}
    B -- Yes --> C["Win32API GetSystemMetrics宣言と定数定義"]
    C --> D["SM_定数を指定してGetSystemMetricsを呼び出し"]
    D -- システムから情報取得 --> E{"取得したメトリック値の分析"}
    E --> F["OfficeアプリのUI/動作を動的に調整"]
    F --> G["Excel/Accessウィンドウのサイズ・位置設定"]
    F --> H["フォーム/レポートの表示最適化やメッセージ表示"]
    G --> I["処理完了"]
    H --> I
    B -- No --> I

実装

ここでは、ExcelとAccessを対象に、GetSystemMetricsを活用した具体的なコード例を2つ示します。

1. Excel: 画面解像度に基づいたウィンドウ配置の自動調整

この例では、GetSystemMetricsを使用してプライマリディスプレイの画面サイズと仮想画面の座標を取得し、Excelアプリケーションウィンドウを特定のサイズや位置に調整します。特に、マルチモニター環境において、Excelウィンドウをプライマリ画面の中央に配置するといったシナリオで有用です。

' 標準モジュールに記述
Option Explicit

' Win32 API GetSystemMetrics関数の宣言
' PtrSafeは64ビット版Officeで必須
#If VBA7 Then

    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else

    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If

' GetSystemMetricsで利用する主な定数
Private Const SM_CXSCREEN As Long = 0      ' プライマリモニタの幅
Private Const SM_CYSCREEN As Long = 1      ' プライマリモニタの高さ
Private Const SM_CXVIRTUALSCREEN As Long = 78 ' 仮想画面の幅 (全モニタの合計幅)
Private Const SM_CYVIRTUALSCREEN As Long = 79 ' 仮想画面の高さ (全モニタの合計高さ)
Private Const SM_XVIRTUALSCREEN As Long = 76 ' 仮想画面の左端X座標
Private Const SM_YVIRTUALSCREEN As Long = 77 ' 仮想画面の上端Y座標

'''
''' Excelウィンドウをプライマリ画面の中央に配置し、サイズを調整するプロシージャ
'''
Sub AdjustExcelWindowToPrimaryScreen()

    ' 性能チューニング開始
    ' 画面描画を一時停止し、処理速度を向上させる（体感で数倍から数十倍速くなることがある）
    Application.ScreenUpdating = False
    ' 計算モードを手動に設定（大規模な計算シートで効果的、数秒から数分の短縮も可能）
    Dim originalCalculation As XlCalculation
    originalCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    On Error GoTo ErrorHandler

    Dim screenWidth As Long
    Dim screenHeight As Long
    Dim virtualScreenWidth As Long
    Dim virtualScreenHeight As Long
    Dim virtualScreenX As Long
    Dim virtualScreenY As Long

    ' プライマリモニタの解像度を取得
    screenWidth = GetSystemMetrics(SM_CXSCREEN)
    screenHeight = GetSystemMetrics(SM_CYSCREEN)

    ' 仮想画面の情報を取得 (マルチモニタ環境での全画面領域)
    virtualScreenWidth = GetSystemMetrics(SM_CXVIRTUALSCREEN)
    virtualScreenHeight = GetSystemMetrics(SM_CYVIRTUALSCREEN)
    virtualScreenX = GetSystemMetrics(SM_XVIRTUALSCREEN)
    virtualScreenY = GetSystemMetrics(SM_YVIRTUALSCREEN)

    ' デバッグ用: 取得した情報をイミディエイトウィンドウに出力
    Debug.Print "--- システム情報取得 (" & Format(Now, "yyyy/mm/dd hh:nn:ss") & ") ---"
    Debug.Print "プライマリ画面幅: " & screenWidth & " px"
    Debug.Print "プライマリ画面高: " & screenHeight & " px"
    Debug.Print "仮想画面幅: " & virtualScreenWidth & " px"
    Debug.Print "仮想画面高: " & virtualScreenHeight & " px"
    Debug.Print "仮想画面左端X: " & virtualScreenX & " px"
    Debug.Print "仮想画面上端Y: " & virtualScreenY & " px"

    ' Excelウィンドウをプライマリ画面の幅の約80%、高さの約70%に調整
    ' かつプライマリ画面の中央に配置
    Dim targetWidth As Long
    Dim targetHeight As Long
    Dim targetLeft As Long
    Dim targetTop As Long

    targetWidth = Int(screenWidth * 0.8)
    targetHeight = Int(screenHeight * 0.7)
    targetLeft = virtualScreenX + (screenWidth - targetWidth) \ 2
    targetTop = virtualScreenY + (screenHeight - targetHeight) \ 2

    With Application
        .Left = targetLeft
        .Top = targetTop
        .Width = targetWidth
        .Height = targetHeight
        .WindowState = xlNormal ' 最大化状態を解除してサイズ変更を可能にする
    End With

    MsgBox "Excelウィンドウをプライマリ画面の中央に調整しました。", vbInformation

ExitSub:
    ' 性能チューニング終了
    Application.Calculation = originalCalculation
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    GoTo ExitSub
End Sub

実行手順:

  1. Excelを開き、Alt + F11でVBAエディタを起動します。

  2. 左側のプロジェクトエクスプローラーで、対象のブックを右クリックし、「挿入」>「標準モジュール」を選択します。

  3. 上記のVBAコードをモジュールに貼り付けます。

  4. プロシージャAdjustExcelWindowToPrimaryScreen内にカーソルを置き、F5キーを押して実行します。

  5. Excelウィンドウが自動的にプライマリ画面の中央に配置され、サイズが調整されることを確認します。

ロールバック方法: VBAコードを削除するか、Excelウィンドウを手動で元の状態に戻してください。本コードはシステムの永続的な設定を変更するものではありません。

2. Access: マウス設定に基づいたフォーム表示の調整

この例では、GetSystemMetricsを使用してマウスの有無や左右ボタンが入れ替わっているか（左利き用設定か）を判定し、Accessフォームの表示やユーザーへのメッセージを調整します。

' 標準モジュールに記述
Option Explicit

' Win32 API GetSystemMetrics関数の宣言
#If VBA7 Then

    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else

    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If

' GetSystemMetricsで利用する主な定数
Private Const SM_MOUSEPRESENT As Long = 19 ' マウスがインストールされているか
Private Const SM_SWAPBUTTON As Long = 23   ' マウスの左右ボタンが入れ替わっているか

'''
''' マウス設定をチェックし、Accessフォームの表示やメッセージを調整するプロシージャ
''' (例として、特定のフォームを開く前に呼び出すことを想定)
'''
Sub CheckMouseSettingsAndAdjustForm()

    On Error GoTo ErrorHandler

    Dim isMousePresent As Long
    Dim areButtonsSwapped As Long

    ' マウスの有無をチェック
    isMousePresent = GetSystemMetrics(SM_MOUSEPRESENT)
    ' 左右ボタンの入れ替え状態をチェック (0=通常, 非0=入れ替え済み)
    areButtonsSwapped = GetSystemMetrics(SM_SWAPBUTTON)

    ' デバッグ用: 取得した情報をイミディエイトウィンドウに出力
    Debug.Print "--- マウス設定情報取得 (" & Format(Now, "yyyy/mm/dd hh:nn:ss") & ") ---"
    Debug.Print "マウスの有無: " & IIf(isMousePresent <> 0, "あり", "なし")
    Debug.Print "マウスボタン左右入れ替え: " & IIf(areButtonsSwapped <> 0, "はい (左利き用)", "いいえ (右利き用)")

    If isMousePresent = 0 Then
        MsgBox "マウスが検出されませんでした。キーボード操作に慣れていることを前提とします。", vbExclamation, "マウス非検出"
        ' 例えば、キーボード操作に最適化されたフォームを開く、または特定のナビゲーションを有効にする
        ' DoCmd.OpenForm "KeyboardOptimizedForm"
    Else
        If areButtonsSwapped <> 0 Then
            MsgBox "マウスの左右ボタンが入れ替わっています（左利き用設定）。ご注意ください。", vbInformation, "マウス設定"
            ' 例えば、フォーム上のボタンのヒント表示を調整するなど
        Else
            MsgBox "マウスは検出され、左右ボタンは標準設定です。", vbInformation, "マウス設定"
        End If
        ' DoCmd.OpenForm "MainForm"
    End If

    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

実行手順:

  1. Accessを開き、Alt + F11でVBAエディタを起動します。

  2. 左側のプロジェクトエクスプローラーで、対象のデータベースを右クリックし、「挿入」>「標準モジュール」を選択します。

  3. 上記のVBAコードをモジュールに貼り付けます。

  4. プロシージャCheckMouseSettingsAndAdjustForm内にカーソルを置き、F5キーを押して実行します。

  5. マウスの有無や左右ボタンの設定に基づいたメッセージが表示されることを確認します。Windowsの「マウスのプロパティ」から左右ボタンの設定を変更し、再度プロシージャを実行して挙動が変わることを確認してください。

ロールバック方法: VBAコードを削除するか、Accessデータベースを元の状態に戻してください。本コードはシステムの永続的な設定を変更するものではありません。

検証

各実装例について、以下の点を確認します。

  • Excelウィンドウ調整:

    • シングルモニター環境で実行し、Excelウィンドウが画面中央に適切に配置され、指定されたサイズになるか。

    • マルチモニター環境で実行し、Excelウィンドウがプライマリモニターの中央に配置されるか。

    • Application.ScreenUpdating = False および Application.Calculation = xlCalculationManual の設定が、ウィンドウ操作前後の体感速度に影響を与えるか。

  • Accessマウス設定:

    • マウスが接続されている状態で実行し、正しく検出されるか。

    • Windowsの「マウスのプロパティ」で「主と副のボタンを切り替える」設定をオン/オフし、Accessのプロシージャ実行時に表示されるメッセージが変化するか。

    • マウスが接続されていない環境（仮想マシンなど）で実行した場合、マウス非検出のメッセージが表示されるか。

これらの検証を通じて、GetSystemMetricsがシステム情報を正確に取得し、それに基づいてVBAコードが意図通りに動作することを確認できます。

運用

GetSystemMetricsを利用したVBAソリューションを運用する際には、以下の点に留意してください。

  • 互換性: Declare PtrSafeを使用することで、32ビット版および64ビット版のOffice両方に対応できますが、古いOfficeバージョン（VBA7以前）ではPtrSafeキーワードが使用できないため、#If VBA7 Then ... #Else ... #End Ifディレクティブによる条件付きコンパイルが必須です。

  • エラーハンドリング: GetSystemMetrics自体がエラーを返すことは稀ですが、API呼び出し全般に言えることとして、On Error GoToステートメントを使用して予期せぬエラー（例: DLLが見つからないなど）に対応することが重要です。

  • ユーザー環境の変化: ユーザーがモニター構成を変更したり、マウスの設定を変えたりする可能性があるため、これらのスクリプトは常に最新のシステム情報を取得するよう設計し、必要に応じて再実行を促すメカニズムを設けることも検討できます。

  • 文書化: どのシステムメトリックを、どのような目的で取得しているのかをコード内コメントや別途ドキュメントで明確にしておくことで、将来的なメンテナンスが容易になります。

落とし穴

GetSystemMetricsを使用する際の一般的な落とし穴をいくつか挙げます。

  • PtrSafeの欠如: 64ビット版のOffice環境でPtrSafeキーワードなしにDeclareステートメントを使用すると、「コンパイルエラー: プロジェクトまたはライブラリが見つかりません」などのエラーが発生します。これはVBAのポインターサイズの違いに起因します。常にPtrSafeを使用するか、#If VBA7ディレクティブで対応することが推奨されます。

  • DPIスケーリング: GetSystemMetricsは、多くの場合、物理ピクセル単位の値を返します。WindowsはDPIスケーリング（高解像度ディスプレイでの表示拡大）をサポートしており、GetSystemMetricsで取得したピクセル値が、実際に画面に表示される論理ピクセルとは異なる場合があります。DPIスケーリングを考慮した正確なサイズを取得するには、GetDpiForWindowやGetDpiForMonitorといったより新しいAPIの使用を検討する必要がありますが、これらはVBAからの利用がさらに複雑になります。本記事の例では、OSの設定に依存しない物理的なスクリーンサイズを基にしているため、多くの場合は問題になりません。

  • システム環境の動的な変化: ユーザーがアプリケーション実行中にディスプレイを接続解除したり、設定を変更したりした場合、GetSystemMetricsで取得した情報が古くなる可能性があります。必要に応じて、イベントドリブンで情報を再取得する仕組みを設けるか、ユーザーに再実行を促す必要があります。

  • 定数の定義ミス: SM_定数の値は、learn.microsoft.comなどの公式ドキュメントで確認できますが、定義ミスは予期せぬ結果を招きます。正確な値をVBAモジュール内に記述してください（2024年3月29日に更新されたMicrosoft LearnのGetSystemMetricsドキュメントが信頼性の高い情報源です）。

まとめ

VBAからWin32 API GetSystemMetricsを利用することで、Officeアプリケーションの自動化において、ユーザーのシステム環境に合わせた高度な制御と柔軟なUI調整が可能になります。画面解像度の取得によるウィンドウ配置の最適化や、マウス設定に応じた振る舞いの変更など、標準VBA機能では実現が難しい要件を満たすことができます。

Declare PtrSafeによるAPI宣言の正しい記述と、適切なSM_定数の選択が重要ですが、一度これを習得すれば、Officeソリューションの可能性を大きく広げることができるでしょう。本記事で紹介した実装例と運用上の注意点を参考に、ご自身の業務環境に合わせたカスタマイズに挑戦してみてください。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

タイトルとURLをコピーしました