Excel VBAでフォームの最大化/最小化ボタンを設定するコードが上手く動かない

Question

Excel VBAのユーザフォームに最大化/最小化するボタン設定及び、
閉じるボタンの無効化をしたく、
ネットで調べたところWindows APIを使用するコードの例が記載されていたので、
それを参考にコードを記述しました。
すると、あるフォームでは最大化/最小化ボタンが追加され、閉じるボタンも無効化され、意図した挙動になったのですが、
同じエクセルブックの別のフォームでは最大化/最小化ボタンは追加されず、閉じるボタンのみ無効化され、意図した挙動になりませんでした。特にエラーメッセージも出ておりません。
原因がわからず困っております。
最大化/最小化を設定できないフォームの条件があるのでしょうか。
わかる方おりましたら教えていただけいただけますと幸いです。
Excel2016 32bit、windows10のPCを使用しています。

◆標準モジュールに記述したコード
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
Declare Function GetSystemMenu Lib "user32.dll" _
(ByVal hWnd As Long, ByVal bRevert As Long) As Long
Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long

Public Const GWL_STYLE = -16
Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0&
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000

◆各ユーザーフォームのInitializeに記述したコード(各フォームには同じコードを記述)
Dim wRet As Long
Dim hWnd As Long
Dim wStyle As Long
Dim hMenu As Long
Dim rClose As Long

hWnd = FindWindow("ThunderDFrame", Me.Caption)
wStyle = GetWindowLong(hWnd, GWL_STYLE)
wStyle = (wStyle Or WS_THICKFRAME Or _
WS_MAXIMIZEBOX Or WS_MINIMIZEBOX)
wRet = SetWindowLong(hWnd, GWL_STYLE, wStyle)
hMenu = GetSystemMenu(hWnd, 0&)
rClose = DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
wRet = DrawMenuBar(hWnd)

Answer 1

ユーザーフォームのキャプションを変更すると、設定がいくつかリセットされるので、そのせいかもしれません。

それ以外で、いくつか気になった点を。

1.Windows API の記述が古い。

Excel2016 32bit なので動作はするはずですが、VBA7より前のバージョン用の古い記述です(現行は7.1)。
MS Officeのバージョンアップ時に動かなくなる可能性があるため、記述を更新した方がベターでしょう。

新しい記述は、以下からダウンロードできるファイルが参考になります。

Download Office 2010 Help Files: Win32API_PtrSafe with 64-bit Support from Official Microsoft Download Center

2.UserForm_Initialize に処理を記述している

UserForm_Initializeの段階では内部的にはフォームが生成されているものの、画面に表示されていないため、若干不安感があります。

UserForm_Activateにすると表示されたときになるので、こちらの方がいいかもしれません。

3.Windows API の返り値をチェックしていない

Windows APIははエラーを返り値で返すことが多いため、正常に動いているかは、返り値を確認しないといけません。

---

参考にWindows APIなどを書き直した物になります。

'標準モジュール

'https://msdn.microsoft.com/ja-jp/windows/ms633499(v=vs.80)
Public Declare PtrSafe Function _
    FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String _
    ) As LongPtr
'https://msdn.microsoft.com/ja-jp/windows/ms633585(v=vs.80)
Public Declare PtrSafe Function _
    GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" ( _
        ByVal hWnd As LongPtr, ByVal nIndex As Long _
    ) As LongPtr
'https://msdn.microsoft.com/ja-jp/windows/ms644898%28v=vs.80%29?f=255&MSPPError=-2147217396
Public Declare PtrSafe _
    Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" ( _
        ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr _
    ) As LongPtr
'https://docs.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-drawmenubar
Public Declare PtrSafe Function _
    DrawMenuBar Lib "user32" ( _
        ByVal hWnd As LongPtr _
    ) As API_BOOL
'https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getsystemmenu
Public Declare PtrSafe Function _
    GetSystemMenu Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal bRevert As Long _
    ) As LongPtr
'https://docs.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-deletemenu
Public Declare PtrSafe Function _
    DeleteMenu Lib "user32" ( _
        ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long _
    ) As API_BOOL

Public Const GWL_STYLE = -16
Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0&
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000

Public Enum API_BOOL
    apiFalse = 0
    apiTrue = 1
End Enum

'フォーム
Private Sub UserForm_Activate()
    'このフォームのハンドルを取得。
    Dim hWnd As LongPtr
    hWnd = FindWindow("ThunderDFrame", Me.Caption)
    If hWnd = 0 Then
        '取得できていない
        Stop
    End If
    
    Dim wStyle As LongPtr
    wStyle = GetWindowLongPtr(hWnd, GWL_STYLE)
    '最大化・最小化ボタンフラグを立てる
    wStyle = (wStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX)
    Call SetWindowLongPtr(hWnd, GWL_STYLE, wStyle)
    
    Dim hMenu As LongPtr
    hMenu = GetSystemMenu(hWnd, 0&)
    Dim rClose As API_BOOL
    rClose = DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
    If rClose <> apiTrue Then
        '何か失敗している
        Stop
    End If
    
    Dim wRet As API_BOOL
    wRet = DrawMenuBar(hWnd)
    If wRet <> apiTrue Then
        '何か失敗している
        Stop
    End If
    
End Sub

---

191128 20:22 追記

Public Sub ChangeUserFormStyle(inFormCaption As String)
    Const ClassNameOfVBAUserFrom = "ThunderDFrame"
    'このフォームのハンドルを取得。
    Dim hWnd As LongPtr
    hWnd = FindWindow(ClassNameOfVBAUserFrom, inFormCaption)
    If hWnd = 0 Then
        '取得できていない
        Stop
    End If
    
    Dim wStyle As LongPtr
    wStyle = GetWindowLongPtr(hWnd, GWL_STYLE)
    'リサイズ可能・最大化・最小化ボタンフラグを立てる
    wStyle = (wStyle Or WS_THICKFRAME Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX)
    Call SetWindowLongPtr(hWnd, GWL_STYLE, wStyle)
    
    Dim hMenu As LongPtr
    hMenu = GetSystemMenu(hWnd, 0&)
    Dim rClose As API_BOOL
    rClose = DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
    If rClose <> apiTrue Then
        '何か失敗している
        Stop
    End If
    
    Dim wRet As API_BOOL
    wRet = DrawMenuBar(hWnd)
    If wRet <> apiTrue Then
        '何か失敗している
        Stop
    End If
    
End Sub

Comments

[d1234]

回答、およびコード記述ありがとうございます。
実は前任担当者がやめてしまいドキュメントがない上に複雑なVBAが組まれており、
それを直さなければいけない状況のため苦戦しています。

>ユーザーフォームのキャプションを変更すると、設定がいくつかリセットされるので、
>そのせいかもしれません。
上手く最大化最小化ボタンが設定できないユーザーフォームは、
標準モジュールの中でユーザーフォームのキャプションを変更しておりました。
キャプション変更の部分をコメントアウトすると意図した挙動になるのですが、
別のところでユーザーフォームのキャプションを使用している部分があり、
キャプション変更の部分は残さざるを得ない状況です。

実行されるVBAを補足すると、
①ユーザーフォーム1(名称仮)のコマンドボタンを押す
②標準モジュールのサブプロシージャ―が呼び出される
　(このサブプロシージャ―でユーザ―フォーム2のキャプション名を変更している
　 ※キャプション名変更は一部で、その他いろいろ実行している)
③ユーザーフォーム1のサブプロシージャ―が呼び出される
　(このサブプロシージャ―でユーザーフォーム2とユーザ―フォーム3を起動している)
※ユーザフォーム2はキャプション名を変更している、
　ユーザーフォーム3はキャプション名を変更していない
　上手く最大化最小化ボタンが設定できないのはユーザーフォーム2です。

いただいたコードを記述して実行しますと、
ユーザーフォーム2が表示された際は最大化最小化ボタンは見えない状態で、
ユーザーフォーム2をクリックすると最大化最小化ボタンが現れますが、
ユーザーフォーム2を掴んで移動させようとすると以下のポイントで止まります。
If rClose <> apiTrue Then
'何か失敗している
Stop　→　ここで止まる
End If

このような挙動になるのですが、
どのようにしたらよいか教えていただけないでしょうか。

[imihito]

キャプションを変更が必須であれば、キャプション変更の度にボタン設定をすればよいでしょう。
現状だと取り回しにくいので、追記した`ChangeUserFormStyle`のように別の処理に切り分けてしまうとやりやすいと思います(フォーム毎の処理で違うのはフォームのキャプションだけなので)。

また、閉じるボタンはキャプションを変更しても無効化されたままなので、`DeleteMenu`が失敗してしまうのだと思います。
その箇所は無視(Stopを消す)してしまってもいいかもしれません。
閉じるボタンであれば`UserForm_QueryClose`イベントでも、(実質的に)無効化できるので、無視が嫌であればそちらの手もありでしょう。

[d1234]

ありがとうございます。
追記いただいた`ChangeUserFormStyle`を標準モジュールに追加し、
Caption変更の後に`ChangeUserFormStyle`を呼び出すことで上手くいきました。
Delete Menuが失敗する箇所は無視するか、QueryCloseで閉じるボタンを実質的に無効化するかどうかは検討します。

Answer 2

今晩は。

間違っていたら ごめんなさい。

ユーザーフォームの設定は
大体の事は　[表示] →［プロパティーウインドウ］で、
左下に出てくるウインドウで設定できますよ。

プロシージャー は あんまり書かなくても OK だと思います。

UserForm1.Show vbModeless　　← ユーザーフォームの表示

Unload UserForm1　　← ユーザーフォームを閉じる

必須なのは。それくらいです。

キャンセルボタンも

Call CButton_Enabled(False)　もしくは

Cancel buttan.（ ）←ココに　↓ コレラを

True か False 　　(有効 ？ 無効 ？)

Hide か Hiden 　　(表示 ？ 非表示 ？)
を設定していく。

後は、色々貼り付けて 移動させたり、サイズ変えたり・・・。

いいフォーム作って下さい。

Comments

[d1234]

回答ありがとうございます。
imihito様への回答でも書かせていただいた通り、前任者の複雑なvbaを修正しなければいけない状況でした。
おっしゃる通り、私も極力シンプルなものを作りたいと思っています。

Answer 3

モジュールの先頭に Option Explicit は書いてありますか？
もし、書いてないのなら、どこかでタイプミスしてる可能性が。

Comments

[d1234]

回答ありがとうございます。
imihito様への回答でも書かせていただいた通り、前任者の複雑なvbaを修正しなければいけない状況でした。
Option Explicitは記載してません、おそらく最初はシンプルなものを作っていたがだんだんと要望に応えるうちに複雑になっていったのだと推測します。使ってないモジュールやらフォームやらたくさんあって解読するだけで大変です。今は納期があるので最低限だけ修正して、今後作り替えたいと思っています。