Help us understand the problem. What is going on with this article?

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

はじめに

仕事でエクセルからフォームに写真や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
Hacomo
業務改善が趣味なただの事務職。職場はオフライン。
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした