2
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

ユーザーフォームの最大化・最小化・サイズ可変を設定するクラス

Posted at

#はじめに
仕事でエクセルからフォームに写真やDocuWorksを表示する機会があり、3回位コピペしたときに「これクラスにしとけば後で楽できる」と思い、フォームサイズを可変にする機能をクラスモジュールに分離しました。

#使い方
1.標準モジュールやフォームのコード内でnewする
2.Formプロパティにフォームをセットする
 ※デフォルトでは全て有効になっています。
 ※フォームのCaptionを変更した場合、ボタンのない状態に戻るので、Redrawメソッドで再描画します。 
上記のほか、任意のタイミングで最大化・最小化ボタン、サイズ可変の有効/無効が変更できます。

######ユーザーフォームで使う場合
Withブロックは省略してもOK。デフォルトで最大化・最小化ボタンとサイズ可変が有効になります。

UserForm1
Option Explicit

Private rfc As ResizableFormClass

Private Sub UserForm_Initialize()
Set rfc = New ResizableFormClass
Set rfc.Form = Me
'設定を変更した場合はRedrawする
With rfc
    .Maximize = True  'Default = True
    .Minimize = True  'Default = True
    .Resize = True    'Default = True
    .Redraw           '再描画
End With
End Sub

Private Sub UserForm_Terminate()
Set rfc = Nothing
End Sub

######標準モジュールで使う場合
一応、標準モジュールからの後付でもボタン設置は可能ですが、フォームの方でリサイズイベントの対応しないとコントロールが動きません。同じくWithブロックは省略可。

Module1
Option Explicit

Sub ResizableFormShow()
Dim UF  As UserForm1
Dim rfc As ResizableFormClass

Set UF = New UserForm1
Set rfc = New ResizableFormClass

Set rfc.Form = UF

'設定を変更した場合はRedrawする
With rfc
    .Maximize = True  'Default = True
    .Minimize = True  'Default = True
    .Resize = True    'Default = True
    .Redraw           '再描画
End With
UF.Show

'フォームのCaptionを変更した場合、もとに戻るので再描画する
UF.Caption = "myForm"
rfc.Redraw
End Sub

#コード

ResizableFormClass.cls
Option Explicit

'Windows API宣言
Private Declare Function FindWindow _
    Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

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 DrawMenuBar _
    Lib "user32" ( _
        ByVal hwnd As Long) As Long

'Windows API定数
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 TargetForm As MSForms.UserForm
Private bMinimize  As Boolean
Private bMaximize  As Boolean
Private bResize    As Boolean

'最小化ボタンの有効/無効
Public Property Get Minimize() As Boolean
Minimize = bMinimize
End Property

Public Property Let Minimize(ByVal flag As Boolean)
bMinimize = flag
End Property

'最大化ボタンの有効/無効
Public Property Get Maximize() As Boolean
Maximize = bMaximize
End Property

Public Property Let Maximize(ByVal flag As Boolean)
bMaximize = flag
End Property

'リサイズの有効/無効
Public Property Get Resize() As Boolean
Resize = bResize
End Property

Public Property Let Resize(ByVal flag As Boolean)
bResize = flag
End Property

'対象フォーム設定
Public Property Set Form(ByRef mform As MSForms.UserForm)
Set TargetForm = mform
Call Redraw
End Property

Public Property Get Form() As MSForms.UserForm
Set Form = TargetForm
End Property

'初期値設定
Private Sub Class_Initialize()
bMinimize = True
bMaximize = True
bResize = True
End Sub

'フォーム再描写 ※Captionを変更した場合、ボタンが消えるのでRedrawする
Public Sub Redraw()
Dim lHwnd  As Long
Dim lStyle As Long

If TargetForm Is Nothing Then Exit Sub

lHwnd = FindWindow("ThunderDFrame", TargetForm.Caption)
lStyle = GetWindowLong(lHwnd, GWL_STYLE)

If Minimize Then
    lStyle = lStyle Or WS_MINIMIZEBOX
End If

If Maximize Then
    lStyle = lStyle Or WS_MAXIMIZEBOX
End If

If Resize Then
    lStyle = lStyle Or WS_THICKFRAME
End If

Call SetWindowLong(lHwnd, GWL_STYLE, lStyle)
Call DrawMenuBar(lHwnd)
End Sub
2
5
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?