作業中のディスプレイにユーザーフォームを表示させる方法 | Excel VBA

2022 1/18

2021年3月20日 2022年1月18日

ユーザーフォームが意図しないディスプレイに表示されるのを解決します。

こんな方向けの記事

ユーザーフォームが意図しないディスプレイに表示されるのを解消します(下の図参照)

2のディスプレイで作業中、ユーザーフォームが別のディスプレイに何故か表示される😖

本記事ではVBAを用い、アクティブウィンドウの中央部に表示します。

作業中のディスプレイに表示させる方法

以下のコードを｢標準モジュール｣と｢ユーザーフォーム｣に貼り付けてください。

VBAコード

本コードは上記サイト様の記事をベースに改変したものとなります。

標準モジュール

Sub UFPositionCenter(UFOb As Object)
  '**ユーザーフォームを親ウィンドウの中央に表示する
  '参考
  'https://dz11.hatenadiary.jp/entry/2019/05/17/090258
  '標準モジュールではMeが使えないので、ユーザーフォーム側にて引数として呼び出す

  '**変数(T=Top,L=Left,W=Width,H=Height,AW=ActiveWindow,UF=UserForm)
  Dim T_AW As Long, L_AW As Long, W_AW As Long, H_AW As Long
  Dim T_UF As Long, L_UF As Long, W_UF As Long, H_UF As Long
  
  '**親ウィンドウの位置とサイズを取得
  With ActiveWindow
    T_AW = .Top
    L_AW = .Left
    W_AW = .Width
    H_AW = .Height
  End With
  
  '**UFのサイズを取得
  W_UF = UFOb.Width
  H_UF = UFOb.Height

  '**UFの表示位置を計算
  T_UF = T_AW + ((H_AW - H_UF) / 2)
  L_UF = L_AW + ((W_AW - W_UF) / 2)
  
  '**UFの表示位置を設定
  UFOb.StartUpPosition = Manual
  '**Top,Left指定時に必須(ないとLeftがずれる)
  UFOb.Top = T_UF
  UFOb.Left = L_UF
End Sub

ユーザーフォーム

Private Sub UserForm_Initialize()
    Call UFPositionCenter(Me)
End Sub

プログラム内容、改良点

プログラム内容

ユーザーフォーム表示時、自身を引数にしてUFPositionCenterを呼び出す
アクティブウィンドウの位置情報を取得
ユーザーフォームのサイズを取得
ユーザーフォームの表示位置を計算し、表示位置を変更
ユーザーフォームをアクティブウィンドウの中央に移動

改変箇所

｢UFPositionCenter()｣をサブルーチン化
ユーザーフォーム側のコードが3行ですみ、メンテナンス性も向上。

3つのディスプレイ使用時

3つのディスプレイを使用する場合、上記のマクロではうまく動かない条件が存在します。

画像のような配置にて、ディスプレイ1，3にて最大化した場合です。

何故かはよくわかりませんが、ActiveWindow.topとleft値が、画像のように想定外の値となるためです。

対応したコードが以下のものとなります。

VBAコード

注意

定数｢rightDisplay_L｣及び、｢rightDisplay_T｣の値は環境によって異なります。
イミディエイトウィンドウ等でactivewindow.top、activewindow.leftの値で座標を確認し、
ご自身で値を見つけてください。
私の環境では最大化時のディスプレイ1，3の Activewindow.leftが-543であったため、
-555<Activewindow.left<0を満たす場合、ディスプレイ1，3 にて最大化していると判定しています。
加えて、ディスプレイ1のActivewindow.topが-2014であったことから、
-2000<Activewindow.topを満たせばディスプレイ3と判定しています。
何故activewindow.topやactivewindow.leftの1/2の値で、うまくいくのか追求していません。

Sub UFPositionCenter(UFOb As Object)
    '**ユーザーフォームを親ウィンドウの中央に表示する
    '参考
    'https://dz11.hatenadiary.jp/entry/2019/05/17/090258
    '**変数(T=Top,L=Left,W=Width,H=Height,AW=ActiveWindow,UF=UserForm)
    Dim T_AW As Long, L_AW As Long, W_AW As Long, H_AW As Long
    Dim T_UF As Long, L_UF As Long, W_UF As Long, H_UF As Long
  
    '**親ウィンドウの位置とサイズを取得
    With ActiveWindow
        T_AW = .Top
        L_AW = .Left
        W_AW = .Width
        H_AW = .Height
    End With
    
    '3ディスプレイ用追加
    '最大化、及びウィンドウ判定定数
    Dim rightDisplay_L, rightDisplay_T As Long
    rightDisplay_L = -555
    rightDisplay_T = -2000
    
    'メインウィンドウ、最大化実行時の補正
    If rightDisplay_L < L_AW And L_AW < 0 Then
        L_AW = L_AW / 2
        If rightDisplay_T < T_AW Then T_AW = T_AW / 2
    End If

  '**UFのサイズを取得
  W_UF = UFOb.Width
  H_UF = UFOb.Height

  '**UFの表示位置を計算
  T_UF = T_AW + ((H_AW - H_UF) / 2)
  L_UF = L_AW + ((W_AW - W_UF) / 2)

  '**UFの表示位置を設定
  UFOb.StartUpPosition = 0

  UFOb.Top = T_UF
  UFOb.Left = L_UF


End Sub