[ExcelVBA] ウィンドウの表示

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧

■お題
ウィンドウの表示(問題出典：どう書く？org)
- 問題詳細 -

画面中央に幅100ピクセル、高さ75ピクセルのウィンドウを表示してください。
タイトルには「こんにちは、GUI！」と表示してください。
使用するGUIライブラリに名前が付いているならば、それをタグでつけてください。(例えば「Swing」など。)

追記：100x75はあまりに小さすぎるようなので、小さすぎるせいでうまく行かない場合は400x300でもいいということにします。 このお題の意図は「小さいウィンドウを出せ」というわけではないので。

■解答例
ポイントは２つ。
・ディスプレイのサイズはどうやって取得するか？
・ポイントとピクセルの違いは？

ExcelVBAでウィンドウサイズを取得できないようなので、WindowsAPIのGetWindowRect関数を使って取得するとよさそうです。

□ウィンドウズＡＰＩとは？

Windows API（ウィンドウズ エーピーアイ）とは、Microsoft WindowsのAPIのことである。特に32ビットプロセッサで動作するWindows 95以降やWindows NTで利用できるものはWin32 APIと呼ばれる。また、それらのWindowsにおけるWin32 APIの実装をWin32と呼ぶ。

(WikiPediaより引用)

平たくいえば、OSの機能を外部プログラムとやりとりするものですね。
WindowsAPIのGetWindowRect関数は、“ウィンドウ”全体の座標を取得することができます。
この関数では、あらゆる“ウィンドウ”の座標を取得できるのでまずどの“ウィンドウ”の座標を知りたいのか指定する必要があります。“ウィンドウの”指定方法は、全ての“ウィンドウ”には重複のない番号が割り当てられているのでその番号を取得してGetWindowRect関数に渡す必要があります。

今回知りたい“ウィンドウ”は、デスクトップです。
デスクトップのハンドルを知るのにGetDesktopWindow関数を使いました。


では、コードです。
まずは、デスクトップのサイズを取得する関数についてです。
モジュール名：SubModule内

Option Explicit

Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Function GetWindowSize() As WindowSize
    Dim hwnd As Long
    hwnd = GetDesktopWindow()
    
    Dim Re As RECT
    Dim Result As Long
    Result = GetWindowRect(hwnd, Re)
    
    Dim WindowSize As WindowSize
    WindowSize.Width = Re.Right - Re.Left
    WindowSize.Height = Re.Bottom - Re.Top
    GetWindowSize = WindowSize
End Function

３行目：デスクトップウィンドウのハンドルを取得するためにWindowsAPIの関数を宣言
４行目：ウィンドウ全体の座標を取得する

６～１１行目：WindowsAPIのGetWindowRect関数の第二引数で使う変数を定義

１３行目：デスクトップの幅と高さを返す関数。返り値に幅と高さを保持したユーザー定義型を返します。
１４行目：hwnd変数、デスクトップのウィンドウハンドルを取得する変数
１５行目：WindowsAPIのGetDesktopWindow関数でデスクトップのウィンドウハンドルを取得

１７行目：変数REをユーザー定義型RECTとして宣言。WindowsAPIのGetWindowRectの第二引数に渡す
１８行目：変数Result、GetWindowRect関数の戻り値を格納。0の時関数は、取得失敗を意味する。
１９行目：WindowsAPIのGetWindowRect関数で第一引数に渡したウィンドウハンドルの座標を取得

２１行目：変数WindowSizeをユーザー定義型WIndowSizeとして宣言
２２行目：ユーザー定義型WindowSizeを宣言した変数のWidthにデスクトップの幅を格納
２３行目：ユーザー定義型WindowSizeを宣言した変数のHeightにデスクトップの高さを格納
２４行目：戻り値としてユーザー定義型WindowSizeを返す


SampleCode1関数を実行することで
・ウィンドウサイズ400x300
・画面中央表示
・タイトルをこんにちは、GUI！
で表示します。

モジュール名：MainModule内

Option Explicit

Type WindowSize
    Height As Long
    Width As Long
End Type

Sub SampleCode1() '問題を含んだコード
    Application.Height = 400
    Application.Width = 300

    Dim DeskTopSize As WindowSize
    DeskTopSize = GetWindowSize()

    Application.Top = DeskTopSize.Height / 2 - Application.Height / 2
    Application.Left = DeskTopSize.Width / 2 - Application.Width / 2

    ActiveWindow.Caption = "こんにちは、GUI！"
End Sub

３～６行目：ユーザー定義型を定義します。
デスクトップの幅と高さを受け取る為に使います。

ウィンドウのサイズを変更します。
タイトルが見づらいので400x300で表示します。
９行目　：ウィンドウの高さを300pxにする
１０行目：ウィンドウの幅を400pxにする

１２行目：変数DeskTopSizeは、デスクトップの幅と高さを受け取る為の変数
１３行目：GetWindowSize関数で、幅と高さを戻り値として受け取る。

ウィンドウの位置をデスクトップの中央に移動します。
(１５、１６行目に問題あり。)
１５行目：デスクトップの高さ÷２ － ウィンドウの高さ÷２
１６行目：デスクトップの幅　÷２ － ウィンドウの幅　÷２

１８行目：タイトルを変更する。

あってそうな気がしますが、残念ながらこれじゃ画面中央に表示されません。
GetWindowRect関数の返す値の単位とApplication.Topや.Leftに指定する値の単位が違います。
・GetWindowRect関数 →px(ピクセル)
・Application.Top/.Left→pt(ポイント)

つまり、単位変換しないと画面中央に表示されません。
pxとptの変換は、
[pt] = [px] ÷ [解像度] × 72
[px] = [pt] × [解像度] ÷ 72

なお、解像度は、
Application.DefaultWebOptions.PixelsPerInchで調べられます。

そこらへんを考慮してSampleCode1関数を書き直すと
モジュール名：MainModule内

Option Explicit

Sub SampleCode2() '完成版
    Dim WindowSize As WindowSize
    Call GetWindowSize(WindowSize)
    Dim dpi As Double
    dpi = Application.DefaultWebOptions.PixelsPerInch '解像度求める

    Application.Width = 100
    Application.Height = 75
    Application.Top = (WindowSize.Height / dpi) * 72 / 2 - Application.Height / 2 'WindowsAPIから得た値はptへ変換する
    Application.Left = (WindowSize.Width / dpi) * 72 / 2 - Application.Width / 2 'WindowsAPIから得た値はptへ変換する
End Sub

よって、最終的なコードは下記になります。
MainModule内のSampleCode2関数を実行すると題意のとおりになります。

モジュール名：MainModule内

Option Explicit

Type WindowSize
    Height As Long
    Width As Long
End Type

Sub SampleCode2() '完成版
    Dim WindowSize As WindowSize
    Call GetWindowSize(WindowSize)
    Dim dpi As Double
    dpi = Application.DefaultWebOptions.PixelsPerInch '解像度求める

    Application.Width = 100
    Application.Height = 75
    Application.Top = (WindowSize.Height / dpi) * 72 / 2 - Application.Height / 2 'WindowsAPIから得た値はptへ変換する
    Application.Left = (WindowSize.Width / dpi) * 72 / 2 - Application.Width / 2 'WindowsAPIから得た値はptへ変換する
End Sub

モジュール名：SubModule内

Option Explicit

Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Function GetWindowSize() As WindowSize
    Dim hwnd As Long
    hwnd = GetDesktopWindow()
    
    Dim Re As RECT
    Dim Result As Long
    Result = GetWindowRect(hwnd, Re)
    
    Dim WindowSize As WindowSize
    WindowSize.Width = Re.Right - Re.Left
    WindowSize.Height = Re.Bottom - Re.Top
    GetWindowSize = WindowSize
End Function

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧