MENU

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

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

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

首が痛いからやめてね

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

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

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

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

VBAコード

日本語入力ソフトとVBAの覚え書き
(Office 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

プログラム内容、改良点

プログラム内容
  1. ユーザーフォーム表示時、自身を引数にしてUFPositionCenterを呼び出す
  2. アクティブウィンドウの位置情報を取得
  3. ユーザーフォームのサイズを取得
  4. ユーザーフォームの表示位置を計算し、表示位置を変更
  5. ユーザーフォームをアクティブウィンドウの中央に移動
改変箇所
  • 「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
シェアしてくださいな