Excel VBA 第5回 Win32APIの取り込みと64bit対応とフォームのサイズ変更

はじめに

Microsoft Excelは、最近はWindowsでも色々なバージョンがあります。
- 32bit版
- 64bit版
- オンライン版
- ストアアプリ版（UWP版）
あまり意識しなくてもよいバージョンかもしれませんが、VBAマクロでWin32APIを使うとなると気になります。
オンライン版については、マクロがそもそも使えないようなので、気にする必要性はないように思います。
ストアアプリ版（UWP版）は、まだ全く想像がつきませんが、まだ使う予定がまったくないので忘れておきます。

32bit版でWin32APIを使用することは問題ありません。
64bit版でWin32APIを使用する場合、ソフトウェアのアドレス空間の拡張に伴い、対応が必要になります。
これまで、32bit版を使用しており、64bit版には縁がなかったものの、対応が必要だということは知っていたため、ネットで調べた情報でなんとなく64bitにも対応しているつもりでした。
Qiitaに記事を載せようと思ったときに、実績のないソースを載せるのもよろしくないと思いましたので、試しに32bit版をアンインストールし、64bit版を入れて、動作するか試してみました。
そうしたら動作せず、修正が必要でしたので、そのあたりをまとめておこうと思います。
UWP版が普及してくるとまた色々ありそうだなと思う今日この頃でした。

はじめに2

nukie_53さんからコメントをいただきましたので、見直しです。

VBA7以降であれば(Excelでいうと2010以降=今サポートされているExcel)であれば、
条件付きコンパイルは不要で、記事の64bit対応コードだけでもいいです。
正確にはLongPtrを使ったコードであれば、LongPtrがLongとLongLongを自動で切り替えてくれるため、使う側では気にする必要がありません。
め、使う側では気にする必要がありません。
VBA7より前ではLongPtrという型がないため、それも対象にしなければいけない場合、あるいは64bit専用のAPI宣言を使う場合に条件つきコンパイルが必要です。

とのことでしたので、試してみました。
おっしゃる通りでした。勉強になりました。
記事を追加します。

今回実施する内容

フォームを作成し、そのフォームのサイズを変更できるようにします。
また、その中のTextBoxもそれに合わせてサイズ変更するものを作ります。

ソースコード(Git Hub)

VBA_05_FormSizeChange

環境

OS:Windows 10 JP
Excel: Excel 2019 (32bit、および64bit）

参考

VBAのフォームサイズを変更する（最小化、最大化も行う）
まさにここをみて、フォームサイズを変更するやり方を学びました。

Office の 32 ビット バージョンと 64 ビット バージョン間の互換性

Office 2010 ヘルプファイル:64 ビットのサポートが含まれる Win32API_PtrSafe

WindowsAPI をOffice64bit版または32bit版のVBAで使うには

用語

なし

標準でフォームのサイズ変更はできない

VBAで標準で作成するフォームのウィンドウは、他のウィンドウズのアプリでは当たり前のことですが、ウィンドウの端っこをドラッグして、サイズを変更することができません。
でも、フォームを作ったら、場合によってはサイズ変更したい時があります。
そんなときにWin32APIを使うとフォームのサイズを変更できるようになります。

フォームのサイズを変更する実装方法１（32bit版でのみ動作する方法）

これは、VBAのフォームサイズを変更する（最小化、最大化も行う）に載っていたそのままで作成できます。
以下のようなソースです。

UserForm1.frm

'-----Constant-----
Private Const GWL_STYLE As Long = (-16)      'ウィンドウスタイルのハンドラ番号
Private Const WS_MAXIMIZEBOX As Long = &H10000  'ウィンドウスタイルで最大化ボタンをつける
Private Const WS_MINIMIZEBOX As Long = &H20000  'ウィンドウスタイルで最小化ボタンを付ける
Private Const WS_THICKFRAME As Long = &H40000   'ウィンドウスタイルでサイズ変更をつける

'-----Windows API宣言-----
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long

'フォームのサイズを変更する。
Public Sub FormResize()
    Dim Hwnd As Long
    Dim WndStyle As Long

    Hwnd = GetActiveWindow()    'ウィンドウハンドルの取得
    WndStyle = GetWindowLong(Hwnd, GWL_STYLE)   'ウィンドウのスタイルを取得
    WndStyle = WndStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX

    Call SetWindowLong(Hwnd, GWL_STYLE, WndStyle)
End Sub

Private Sub UserForm_Activate()
    Call FormResize
End Sub

説明はほとんど省きますが、ちょっとだけ。
Constantは、Win32で定義されている定数ですが、VBAで使う場合その定数は使えないため、改めて必要な分だけ定義しています。
GWL_STYLEは、ウィンドウスタイルの番号で、-16のようですが、なぜか()でくくっています。()をとっても動作するようですが、user32.dllでも(-16)と定義しているようなため、そのままにしています。
WS_MAXIMIZEBOXやWS_MINIMIZEBOXやWS_THICKFRAMEは、ウィンドウスタイルを設定するための定数で、
WndStyle = WndStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX
のように、加えたいものをOrで足していくことになります。
WndStyleの各Bitがウィンドウスタイルの設定Flagになっており、今回の16進数で5桁目の4bitは、最大化や最小化などのFlagというわけです。

上記の図の通り、WS_MAXIMIZEBOXが16進数の5桁目の1bit目で、このFlagを立てると、そのウィンドウの右上に「最大化」ボタンができまます。
2bit目は、「最小化」ボタン。
3bit目は、ウィンドウサイズ変更の許容です。
4bit目は、ウィンドウのタイトルバーにコントロールボックス（「最大化」、「最小化」のボタンのこと）を持つウィンドウを作成するFlagで、これを0にすると、いくらWS_MAXIMIZEBOXやWS_MINIMIZEBOXを設定しても無駄です。
そういう点でいえば、WS_SYSMENUも定義して、Orで付けておいたほうがいいかもしれません。

Orは、設定を追加していくことになりますが、逆に設定したくない場合は、And (Not 値)となります。
例えば、「最小化」ボタンが不要であれば、
WndStyle = WndStyle And (Not WS_MINIMIZEBOX)
となります。

また、「&H」は初めて見たとき何？と思いましたが、これは、16進数であることを示しており、「&H10000」は16進数の10000ということです。

フォームのサイズを変更する実装方法２（32bit版と64bit版で動作させる方法）（Excel 2007以前対応版）

次は、これを64bit版でも動作するようにする方法です。

---追記---
「はじめに2」に記載した通り、コメントを受けました。

ここでの記載は、Excel 2007以前の環境でも動作させるためのものになると思います。

これも色々と記載はありますが、それを参考にしていたのですが、実際に64bit版を入れて試してみたらうまく動作しなかったため、理解が足りていなかったと思いましたので、少し補足します。

UserForm1.frm

Option Explicit

'-----Constant-----
Private Const GWL_STYLE As Long = (-16)      'ウィンドウスタイルのハンドラ番号
Private Const WS_MAXIMIZEBOX As Long = &H10000  'ウィンドウスタイルで最大化ボタンをつける
Private Const WS_MINIMIZEBOX As Long = &H20000  'ウィンドウスタイルで最小化ボタンを付ける
Private Const WS_THICKFRAME As Long = &H40000   'ウィンドウスタイルでサイズ変更をつける
Private Const WS_SYSMENU As Long = &H80000      'ウィンドウスタイルでコントロールメニューボックスをもつウィンドウを作成する
'-----Windows API宣言-----
#If Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#Else
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
#End If

'フォームのサイズを変更する。
Public Sub FormResize()
    #If Win64 Then
        Dim Hwnd As LongPtr
        Dim WndStyle As LongPtr
    #Else
        Dim Hwnd As Long
        Dim WndStyle As Long
    #End If

    Hwnd = GetActiveWindow()    'ウィンドウハンドルの取得
    WndStyle = GetWindowLong(Hwnd, GWL_STYLE)   'ウィンドウのスタイルを取得
    WndStyle = WndStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU

    Call SetWindowLong(Hwnd, GWL_STYLE, WndStyle)
End Sub

Private Sub UserForm_Activate()
    Call FormResize
End Sub

Private Sub UserForm_Resize()
    Dim iHeight As Integer
    Dim iWidth As Integer

    iHeight = Me.InsideHeight - TextBox1.Top * 2
    iWidth = Me.InsideWidth - TextBox1.Left * 2

    If (iHeight > 0 And iWidth > 0) Then
        TextBox1.Height = iHeight
        TextBox1.Width = iWidth
    End If
End Sub

説明です。

• Constant

  WS_SYSMENUを追加しました。念のためです。

• Windows API宣言

  まずはこれ。

    #If Win64 Then
    #Else
    #End If
  

  上記は、条件付きコンパイルです。
  Microsoftのページによれば、

  条件付きコンパイルを使用すると、コード ブロックを選択的に実行することができます。これにより、たとえば、ステートメントのデバッグ、同じプログラミング タスクに対する異なるアプローチの速度の比較、さまざまな言語へのアプリケーションのローカライズなどを行うことができます。

  ということです。
  今回の場合は、これを32bit版と64bit版のExcelで使い分けるということです。
  Win64は定義済みの値であり、64bit版のExcelの場合はTrueで、32bit版はFalseになるということです。
  32bit版のDeclareの記載は、「フォームのサイズを変更する実装方法１」と同じですので、64bit版のDeclareの記載についてです。
  まずは、Office の 32 ビット バージョンと 64 ビット バージョン間の互換性を読むのが良いかと思いますが、ざくっといえば、
  64bit版になってアドレス空間が拡張されたため、Hwndとかポインタなどの範囲が拡張されており、そのままでは動作しないということだそうです。
  ということで、大きく対策は、二つ。

• Declareの後にPtrSafeという記載を追加する。

• Hwndやポインタなどの型を対応したものに書き換える。LongPtrなど。

上記で困ったのは、2つ目で、どういったものにLongPtrとつければいいのか？私が使うレベルでは、だいたいネット上に情報があるので困ることはないのですが、正しくはどれなのかな？と。
しかし、実際にはOffice 2010 ヘルプファイル:64 ビットのサポートが含まれる Win32API_PtrSafeに記載がありました。
ここに記載に従って、ファイルをダウンロードするとインストーラーがあり、インストールすると、Cドライブ直下の「Office 2010 Developer Resources」にインストールされるため、Win32API_PtrSafe.TXTをみれば、どれをLongPtrにするかわかりました。

• FormResize

  ここでも、条件付きコンパイルを設定します。実はこれが理解が足りていなかった点で、Declareで、戻り値の型がLongからLongPtrに変わっているわけなので、それを使う場合も変えないと動作しなかったわけです。
  いつも、型を記載していますが、VBAでは型を書かなくても動作するので、あまり説明がないのだと思いました。
  ですが、それに気づかずにいままでは作っていました（32bit版だったので影響はなかったわけです）。

ということで、載せておこうと思いました。

• UserForm_Resize

  VBAのフォームサイズを変更する（最小化、最大化も行う）に載っていたものそのままです。

フォームのサイズを変更する実装方法２（32bit版と64bit版で動作させる方法）（Excel 2010以降対応版）

ご指摘を受けて、Excel 2019 32bit版を入れなおして確認しましたので載せます。
ご指摘通り、条件付きコンパイルは不要でした。
Excel 2010, 2013, 2016などは試していませんが、たぶん大丈夫なんだろうと思います。

UserForm1.frmの一部

'-----Windows API宣言-----
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr

'フォームのサイズを変更する。
Public Sub FormResize()
        Dim Hwnd As LongPtr
        Dim WndStyle As LongPtr

    Hwnd = GetActiveWindow()    'ウィンドウハンドルの取得
    WndStyle = GetWindowLong(Hwnd, GWL_STYLE)   'ウィンドウのスタイルを取得
    WndStyle = WndStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU

    Call SetWindowLong(Hwnd, GWL_STYLE, WndStyle)
End Sub

• Windows API宣言
  条件付きコンパイルを取りました。

• FormResize
  条件付きコンパイルを取りました。

実はこれでいいことがわかりました。Office 2007のサポートが切れていることから、もうOffice 2010以降だけを気にすればよいと思えば、これで十分なら楽ですね。

ところで、Office 2010 ヘルプファイル:64 ビットのサポートが含まれる Win32API_PtrSafeをもう一度見直してみましたところ、Win32APIは、64bitと32bitで分かれていることに気づきました。

Win32API_PtrSafe.TXT抜粋

...
#If Win64 Then
Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function GetClassLongPtr Lib "user32" Alias "GetClassLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function GetClassLongPtr Lib "user32" Alias "GetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

' Provided for reference only.  Please use the LongPtr versions instead.
Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare PtrSafe Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
...

GetWindowLongPtrAとGetWindowLongAで、後ろのPtrがあるかないかが違います。
Ptrありが64bitで、Ptrなしが32bitのようです。
何の違いがあるのだろうかと検索してみましたが、よくわかりませんでした。
あとはどうでもいいですが、エイリアス名にもPtrをつけているようです。
これを付けておけば、64bitに対応したものと判別できるためよいかと思います。

Win32API_PtrSafe.TXTの記載がMicrosoftのおすすめだと思いましたので、これで実装しておこうかと思います。

UserForm1.frm

Option Explicit

'-----Constant-----
Private Const GWL_STYLE As Long = (-16)      'ウィンドウスタイルのハンドラ番号
Private Const WS_MAXIMIZEBOX As Long = &H10000  'ウィンドウスタイルで最大化ボタンをつける
Private Const WS_MINIMIZEBOX As Long = &H20000  'ウィンドウスタイルで最小化ボタンを付ける
Private Const WS_THICKFRAME As Long = &H40000   'ウィンドウスタイルでサイズ変更をつける
Private Const WS_SYSMENU As Long = &H80000      'ウィンドウスタイルでコントロールメニューボックスをもつウィンドウを作成する
'-----Windows API宣言-----
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr

#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If

'フォームのサイズを変更する。
Public Sub FormResize()
        Dim hwnd As LongPtr
        Dim WndStyle As LongPtr

    hwnd = GetActiveWindow()    'ウィンドウハンドルの取得
    WndStyle = GetWindowLongPtr(hwnd, GWL_STYLE)   'ウィンドウのスタイルを取得
    WndStyle = WndStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU

    Call SetWindowLongPtr(hwnd, GWL_STYLE, WndStyle)
End Sub

Private Sub UserForm_Activate()
    Call FormResize
End Sub


Private Sub UserForm_Resize()
    Dim iHeight As Integer
    Dim iWidth As Integer

    iHeight = Me.InsideHeight - TextBox1.Top * 2
    iWidth = Me.InsideWidth - TextBox1.Left * 2

    If (iHeight > 0 And iWidth > 0) Then
        TextBox1.Height = iHeight
        TextBox1.Width = iWidth
    End If
End Sub

おわりに

今回は、VBAでフォームのサイズ変更を行う方法を記載しました。
よくある内容ですが、他ではあまり記載されていないところで、自分がつまったところを書いてみました。

おわりに2

コメントは非常にありがたいです。
Excelのバージョンにかかわるものでなかなか確認するのも面倒で（自由に使えるPCが1台だったのでインストールとアンインストールの繰り返し）、試すのも限定的でしたので、色々確認ができていませんでした。
また、再度色々調べてみて、より理解が深まったかなと思いました。
助かりました。