質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.81%

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

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 1,440

d1234

score 5

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)

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

+2

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

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

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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/11/28 17:26

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

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

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

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

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

    キャンセル

  • 2019/11/28 20:31

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

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

    キャンセル

  • 2019/11/29 17:53

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

    キャンセル

0

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/11/29 18:08

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

    キャンセル

0

今晩は。

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

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

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

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

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

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

キャンセルボタンも
 
Call CButton_Enabled(False) もしくは

Cancel buttan.( )←ココに ↓ コレラを

True か False      (有効 ? 無効  ?)

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/11/29 18:01

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.81%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る