■ ExcelアプリのGUIを操作する
Excelで本格的なアプリケーションを開発しようという場合、どうしてもExcel本体のUIの操作や、スクリーン座標の取得などが必要になってくるケースが多々あります。
ExcelのGUIを細かく見ていくと、まず本体のアプリケーションウィンドウが大本にあります。メニューやツールバーなどを表示しているウィンドウですね。この中にブックウィンドウが表示されます。
通常、ブックウィンドウを最大化して使うことが多いので、アプリケーションウィンドウの一部のように見られますが、実際はブックウィンドウという独立したオブジェクトです。
エクセルは同時に複数のブックを開くことができますので、複数開いたブックを並べて表示したり、重ねて表示することが可能です。
ブックウィンドウは通常、アクティブなワークシートを表示しているので、保存された時点でアクティブだったワークシートが次回開いた時点でもアクティブ（最初に表示）になっているはずです。
さらにワークシートには表示倍率があり、％単位で指定が可能です。
で、ここまでの話をまとめると…ワークシート上セルのスクリーン座標を取得するということがかなり困難だということが理解いただけると思います。
（クライアント領域内のセル座標取得のことではないですよ。念のため）
まず大本のエクセルアプリケーションウィンドウが最大化されているのか？通常表示ならスクリーン上のどこにあるのか？メニューやツールバーがどんな状態なのか？ブックは最大化されているのか？タイル表示なのか？ワークシートの拡大倍率は？
これらの要素を加味しながら、常に選択したセルのスクリーン座標を取得することは可能なのでしょうか？
さっそくコードを書いてみましょう。
' モジュール宣言部に記述ここから −−−−−−−−−−−−−−−−−−−−−−−−−−
'（検証用）
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
' モジュール宣言部に記述ここまで −−−−−−−−−−−−−−−−−−−−−−−−−−
' ワークシートモジュールに記述ここから −−−−−−−−−−−−−−−−−−−−−−−
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'（実行用）
Dim R1C1Left As Long
Dim R1C1Top As Long
Const DPI As Long = 96
Const PPI As Long = 72
R1C1Left = ActiveWindow.PointsToScreenPixelsX(0)
R1C1Top = ActiveWindow.PointsToScreenPixelsY(0)
Range("a1") = ((Selection.Left * DPI / PPI) * (ActiveWindow.Zoom / 100)) _
+ R1C1Left
Range("a2") = ((Selection.Top * DPI / PPI) * (ActiveWindow.Zoom / 100)) _
+ R1C1Top
'（検証用）
Dim Pos As POINTAPI
Dim MouseLeft As Long
Dim MouseTop As Long
GetCursorPos Pos
MouseLeft = Pos.x
MouseTop = Pos.y
Range("a3") = MouseLeft
Range("a4") = MouseTop
End Sub
' ワークシートモジュールに記述ここまで −−−−−−−−−−−−−−−−−−−−−−−
こんな感じになります。ずいぶん簡単に書けちゃいましたね。
標準モジュールに定義しているAPIのGetCursorPos関数は、検証用に使っているだけなので実際は必要ありません。
イベントプロシージャはワークシートモジュール内のWorksheet_SelectionChangeイベントです。
適当なワークシートのモジュールに記述してください。
こちらも後半部分、Dim Pos As POINTAPI〜以降は検証用なので特に必要ありません。
イベントを記述したワークシートのセルを選択するとA1、A2セルに選択したセルの左上位置スクリーン座標が、A3、A4セルにクリック時のマウスポインタのスクリーン座標が表示されます。
微妙に異なるのはマウスポインタがセルの左上隅を正確にクリックしていないからです。できるだけ左上隅に近いところをクリックすれば、A1、A2とA3、A4の値は同じになります。
さてコードを詳しく見ていきましょう。
まず、ActiveWindow.PointsToScreenPixels〜ですが、これが今回のコードのかなめになります。
このメソッドは、エクセルワークシートのA1セルのスクリーン上の座標をピクセル値（Long型）で返します。
PointsToScreenPixelsXならX座標、PointsToScreenPixelsYならY座標を返すだけです。
（引数は単純に返り値に加算されるだけなので今回は0を指定しています）
Selection.Left、Selection.Top、こちらは単にワークシートの左上位置から選択セルの左上位置のポイント値を返します。
ここで注意していただきたいのはExcel内で使うPointとスクリーン座標のPixcelとでは取得している単位が異なるという点です。Excel内で用いるポイントは72dpi、Windowsが用いるピクセルは96dpiです。（※注１参照）
ポイント<--->ピクセルの変換は掛け算、割り算で行えるのでどうということはないですが、これを知らないと座標の指定が思い通りにいきません。
今回はDPIという定数にピクセルの96をPPIという定数にポイントの72を持たせました。
DPIをPPIで割って選択セルの位置（ポイント）に掛けてやりピクセル値に変換しているだけです。
その後ろの、ActiveWindow.Zoom/100 は何をしているのかというとワークシートの表示倍率を先ほどのピクセル値（ポイントから変換済み）に掛けてやっているだけです。これでワークシートのズーム倍率が変わっても正しい座標が取得できます。
最後にPointsToScreenPixels〜で取得した基準点（A1のスクリーン座標）を足してやれば、ウィンドウがどのような状態でも正しいスクリーン座標を取得することができます。
これを応用すればユーザーフォームを決められたセル位置に配置するとか、マウスポインタにオートシェイプを追従させることも簡単に可能になります。
拙作、Cellメタルではこの手法をふんだんに使用し、Excelワークシート上で実現不可能と言われた動きを再現しています。興味のある方はぜひお試しください。フリーソフトです。
エクセル経営シミュレーション「Cellメタル」
（ソースコード公開版もＤＬできます）
せっかくですのでＶＢＡから操作できるウィンドウのサイズや位置の指定を他にもご紹介しておきます。
| エクセルのアプリケーションウインドウを操作する、状態を取得する |
| Application.Top |
縦位置の指定、取得 |
| Application.Left |
横位置の指定、取得 |
| Application.Width |
幅の指定、取得 |
| Application.Height |
高さの指定、取得 |
| Application.Windowstate=xlMaximized |
最大化 |
| Application.Windowstate=xlNormal |
通常化 |
| Application.Windowstate=xlMinimized |
最小化 |
| アクティブワークブックウィンドウを操作する、状態を取得する |
| ActiveWindow.Top |
縦位置の指定、取得 |
| ActiveWindow.Left |
横位置の指定、取得 |
| ActiveWindow.Width |
幅の指定、取得 |
| ActiveWindow.Height |
高さの指定、取得 |
| ActiveWindow.Windowstate=xlMaximized |
最大化 |
| ActiveWindow.Windowstate=xlNormal |
通常化 |
| ActiveWindow.Windowstate=xlMinimized |
最小化 |
| （上記の単位はすべてポイントです） |
※注１
Windowsが用いるピクセル数は使用するマシンのプロパティにより異なります。
画面のプロパティ＞設定＞詳細設定＞全般＞DPI設定 により設定されています。デバイス固有の情報を取得するには、API関数のGetDeviceCapsを利用します。
' モジュール宣言部に記述ここから −−−−−−−−−−−−−−−−−−−−−−−−−−
Private Const LOGPIXELSX As Long = &H58&
Private Const LOGPIXELSY As Long = &H5A&
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDc As Long, _
ByVal nIndex As Long _
) As Long
Private Declare Function GetDC Lib "user32" ( _
ByVal hWnd As Long _
) As Long
Private Declare Sub ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hDc As Long _
)
' モジュール宣言部に記述ここまで −−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub Sample()
Dim hWnd As Long
Dim hDc As Long
hWnd = Excel.Application.hWnd
hDc = GetDC(hWnd)
'水平方向DPI
Debug.Print GetDeviceCaps(hDc, LOGPIXELSX)
'垂直方向DPI
Debug.Print GetDeviceCaps(hDc, LOGPIXELSY)
ReleaseDC hWnd, hDc
End Sub
上記サンプルコードで、デバイス固有のピクセル情報を取得できます。
|
|
|
