軽い気持ちというかほとんどネタで、VBAのユーザーフォームを用いたなんちゃってモダンなDatePickerを作ってみたのですが、その際に「セルの右横にユーザーフォームを表示する」という一見簡単そうなことが一筋縄ではいきませんでした。
試行錯誤の結果、ひとまずは実用にできそうな手法がわかったので、備忘として記事にしておきます。
せっかちな方へ
「能書きはいいから具体例を出せ」という向きは、
こちらに実装例(マクロ有効ワークシート(*.xlsm))とソースコードを置いてあるので、ご自分で読み解いてください。
ちなみにこれを利用して作ったDatePicker(カレンダー)はこちら。
前提知識
- エクセルVBAでは、オブジェクト(Window、Range、UserForm等)の位置や大きさは、基本的に「ポイント」という単位で管理されている(Top/Left/Width/Height等のプロパティの数値は全てポイント単位)
- 位置を表す座標系には、大きく分けて、画面*1の左上を原点とする「画面座標系」(WindowオブジェクトやUserFormオブジェクト等はこちらで考える)と、ワークシートの左上*2を原点とする「ドキュメント座標系」(Rangeオブジェクト等はこちらで考える)とが存在する*3
- 「画面座標系」と「ドキュメント座標系」とでは、同じ1ポイントであっても、画面上における大きさは異なる場合がある(例えばウィンドウの拡大率などに左右される)
- ポイントとピクセル(ドット・画素)との比率も、環境によって異なる場合がある(画面解像度や拡大率に左右される)*4
アクティブセルの右側にユーザーフォームを表示したいときの座標計算方法の具体例
アクティブウィンドウ上にあるアクティブなセルのすぐ右側にユーザーフォームを表示する際の、ユーザーフォームに指定する座標(Top/Leftプロパティ)の値(ポイント)の具体的な求め方を記します。
なお、ここでは例として、
画面 | 横3840ピクセル✕縦2160ピクセル(4K)・拡大率150% |
アクティブウィンドウ | Top:84.0・Left:221.5・Width:1379.0・Height:822.0・拡大率200% |
ウィンドウ枠の固定 | 有り(B3の位置) |
アクティブセル | アドレス:BR118・Top:2106.0・Left:3726.0・Width:54.0・Height:18.0 |
のようになっているものとします。
アクティブセルの位置を画面座標系に変換
アクティブセルのプロパティ(Top/Left)は、ドキュメント座標系上のポイント単位の数値です。
ひとまずこれを、画面座標系へと変換します。
これには、ペイン(Pane)オブジェクトのPointsToScreenPixelsY()/PointsToScreenPixelsX()メソッドを使用します。
このとき注意するのが、アクティブセルが属しているPaneオブジェクトを指定する必要があることです。
ウィンドウ枠の固定をしている場合、ActiveWindow.Panes.Countは最大4まで存在するため、アクティブセルがPanes(1)~Panes(4)のいずれの下にあるかを調べる必要があります。
もっとも、アクティブセルが前提なので、この場合は、PaneオブジェクトとしてActiveWindow.ActivePaneオブジェクトを指定するのが簡単でしょう。
これで、Top: 2106.0ポイント→1003ピクセル、Left: 3726.0ポイント→1399ピクセルのように、アクティブセルの左上の、画面座標上の位置をピクセル単位で求めることができます。
画面座標系上の位置をピクセル単位からポイント単位に変換
求まった値はピクセル単位ですが、ユーザーフォームのプロパティ(Top/Left)に設定しようと思うと、ポイント単位への変換が必要になります。
画面座標系におけるピクセル→ポイントの変換方法として、自分は、ActiveWindowのHeight・Widthプロパティ(ポイント単位)と、WinAPIであるGetWindowRect()により得られるActiveWindowの座標(Top/Bottom/Left/Right・ピクセル単位)から求まる高さ・幅との比率を求めて使う、という方法を思いつきました。
もっと簡便な方法があればご教示願います。
これにより、上記の例では1ポイント=2.0ピクセルと出ましたので、Top:1003ピクセル→501.5ポイント、Left:1399ピクセル→699.5ポイントのように、アクティブセルの左上の、画面座標上の位置をポイント単位に変換できました。
セル幅を画面座標上のポイント単位に変換
セルの「右」に表示するので、横方向の座標にはセル幅(Widthプロパティ)分を加える必要があります。
Widthプロパティはポイント単位なので、これを足せばいいのか……と思いきや、ドキュメント座標上のポイントと画面座標上のポイントでは実サイズが異なってきます。
具体的には、ウィンドウの拡大率に左右されます。
アクティブウィンドウの拡大率は、ActiveWindow.Zoom÷100で求まり、上記の例(200%)だと2.0となります。
よって、ドキュメント座標上のWidth:54.0ポイントは、画面座標上では108.0ポイントとなります。
ユーザーフォームのプロパティを設定
以上により、ユーザーフォームの設定すべき画面座標上の位置は計算上(ポイント値で)Top:501.5、Left:699.5+108.0=807.5となります。
あとは、ユーザーフォームのStartUpPositionプロパティを0(Manual)にして、TopとLeftプロパティに値を設定すればいいわけですが……さらにいくつかハマりどころがあるのが困ったところですね。
ハマりどころ
第3の座標系が存在!?(ユーザーフォームの位置が想定よりも右下にずれていく問題)
環境によっては(画面解像度や拡大率、マルチモニタ等が影響?)上記のようにして計算した値をユーザーフォームのプロパティにセットしても、想定位置からずれてしまう場合があります。
しかも、画面の右下に行くに連れてズレも広がっていくようです。
この現象に最初に遭遇したときにいろいろと試してみたところ、上記の計算値に一定の係数(試したケースでは14/15=0.93…)を掛けたものをTop/Leftプロパティに設定すると、想定位置に表示されることがわかりました。
いわば、画面座標系と原点は共通ですが、目盛(1ポイント当たりの大きさ)の大きい座標系(ユーザーフォーム座標系?)が存在するようなイメージです。
この係数は環境により異なってくるため、定数にすることはできません。
そこで、
- GetWindowRect()でユーザーフォームのピクセル単位での座標を取得し、これから高さと幅を求める(実測値)
- ユーザーフォームのHeight/Widthプロパティに、ActiveWindowから求めたピクセル/ポイント比をかけて、ピクセル単位の高さと幅を求める(想定値)
のように二種の方法で高さと幅を求め、想定値と実測値の比を割り出し、これを係数として使用することで、対応することにしました。
とりあえず、この補正を行うことで、状況は改善されたようです。
画面の右の方にいくと、突然ユーザーフォームが左側にずれるようになる
環境によっては(おそらくマルチモニタ環境でかつ特定の解像度や拡大率の場合に)、画面の左側だと問題なく表示されているのに、あるところから突然ユーザーフォームが想定位置よりも左に大きくずれ始める、という現象が発生することがあります。
調べてみると、Pane.PointsToScreenPixelsX()が返す値が、ある列より右側では明らかにおかしくなっていました。
しばらく原因がわからず途方にくれていたのですが、その後、たまたま気がついたエクセルの設定を変更することで改善されることがわかりました。
ファイル>オプション>設定>全般>ユーザー インターフェイスのオプション>複数ディスプレイを使用する場合
で、
◉ 表示を優先した最適化 (アプリケーションの再起動が必要)
にしていると発生することがあるようで、試しに
◉ 互換性に対応した最適化
に変更(これもエクセルの再起動は必要)すると、
正常動作するようになったようです。
その他注意点・制限事項など
- PoinstsToScreenPixelsY()/PoinstsToScreenPixelsX()は、Panesのどこに所属しているかを意識しないといけないし、そもそも「ウィンドウ上に見えている(表示されている)」もののポイントからしか変換できないため、隠れているセルの座標を指定したりするとエラーになることに注意
- マルチモニタ環境は鬼門(特にモニタの境界線付近にユーザーフォームを表示したいようなケースでは正常に動作しないものと思うべき)
解像度や拡大率の異なるモニタ間の境界線付近でも問題なく動作するような方法があればご教示ください - 環境依存の部分が大きい(WinAPIを使用しているためWindows以外では動作しない・Windows 10 Pro+Microsoft 365 Excel(32ビット)で開発・確認しているが、Excelのバージョンの他、OSのバージョン等にも依存しそう、等)
- 「シートを右から左へ表示する」(Excelのオプション>詳細設定>次のシートで作業するときの表示設定)が有効になっている場合には、正常に動作しない(Pane.PointsToScreenPixelsX()が適切な値を返してくれない)
処理を簡便化するモジュール
上記の処理の一部を簡便化するためのプロシージャ群を標準モジュールとしてまとめてあります。
ConvertToScreenPosition()
Type ScreenPosition x As Double y As Double End Type Function ConvertToScreenPosition(TargetTop As Double, TargetLeft As Double, Optional TargetWindow As Window) As ScreenPosition
ドキュメント座標系の座標(TargetTop/TargetLeft・ポイント)を、画面座標上の座標(ピクセル単位)に変換して返します(変換不可な場合にはx=0・y=0が返ります)。
TargetWindowで対象となるWindowオブジェクトを指定可能です(省略時はActiveWindowになります)。
例えば対象となるセルのTop/Leftを指定するだけでよく、Panesのどれに属しているかは意識しなくても済むようにひと工夫してあります。
GetDisplayDotsPerPoint()
Type DotsPerPoint x As Double y As Double End Type Function GetDisplayDotsPerPoint(Optional TargetWindow As Window) As DotsPerPoint
画面座標系上の1ポイントあたりのドット(ピクセル)数を返します。
TargetWindowで対象となるWindowオブジェクトを指定可能です(省略時はActiveWindowになります)。
SetUserFormPosition()
Type CoordinateFactor x As Double y As Double End Type Function SetUserFormPosition(TargetForm, Top As Double, Left As Double, Optional Calibration As Boolean = True) As CoordinateFactor
TargetFormで指定したユーザーフォームを、画面座標系上の指定位置(Top/Left・ポイント)に移動します(このプロシージャでは表示は行わないことに注意してください。別途、TargetForm.Showプロシージャで表示する必要があります)。
このとき、位置ずれ補正(画面の右下に行くほどにずれる現象に対する補正)も自動で行います(Calibration:=Falseで補正を無効化することもできます)。
戻り値として、適用した補正係数を返します(Calibration:=False時はx=1・y=1が返ります)。
ひとりごと
ユーザーフォームってあまり使った経験がないのですけれど、まさかセルの右横にユーザーフォームを表示するだけでこんなに苦労することになろうとは思いもよりませんでした……。
よりよい方法があれば、ご教示願います。
*1:マルチモニタ環境における「画面」は、すべての有効なモニタ画面を包括するような仮想的な矩形となると思われる
*2:セルの設定で非表示になっているものは含まないため、必ずしもA1ではないことに注意
*3:座標系の名前は便宜上のもので、自分のソースコード内では「ディスプレイ座標系」「ワークシート座標系」などと書いてある場合もある(統一が取れていなくてすみません……)
*4:ネットではDPI(Dots Per Inch)を96として決め打ちしている実装をよくみかけるが、あまり望ましくないと考えられる(ポイント(DTPポイント)の方は1インチあたり72ポイントがもともとの定義。なお、これもPoints Per Inchを略してPPIと書いてしまうと、Pixels Per Inchと混同してしまうため(こちらがより一般的なPPI)混乱の元なので避けたほうがよさそう)