【VBA】ユーザーフォームのサイズを変更した際に自動的にコントロールの大きさや位置を調整する方法

今回はVBAのユーザーフォームのサイズに合わせて、コントロールの拡大縮小と位置の微調整を行う方法を説明していきます。

準備

以下のコードを貼り付けてください

クラスモジュール「FormResizeClass」のコード

ユーザーフォームのサイズを変更した際に自動的にコントロールの大きさや位置を調整するクラスです。

Option Explicit
Private formInfo As New Collection 'フォームとコントロールのサイズ記録用
Private formObj As Object 'フォームのオブジェクト
''' <summary>
'''フォームサイズとコントロールサイズを記録する
''' </summary>
''' <param name="formObj">フォームのオブジェクト</param>
''' <remarks></remarks>
 Sub FormSizeRec(ByRef pFormObj As Object)
    Set formObj = pFormObj
    'フォームのサイズを記録
    With formObj
        formInfo.Add New Collection, .Name
        formInfo(.Name).Add .Width, "Width"
        formInfo(.Name).Add .Height, "Height"
    End With
    'フォーム内の全コントロールのサイズと位置を記録
    Dim con As Variant
    For Each con In formObj.Controls
        With con
            formInfo.Add New Collection, .Name
            formInfo(.Name).Add .Width, "Width"
            formInfo(.Name).Add .Height, "Height"
            formInfo(.Name).Add .Top, "Top"
            formInfo(.Name).Add .Left, "Left"
            '対象プロパティが存在しない場合は無視
            On Error Resume Next
            formInfo(.Name).Add .Font.Size, "FontSize"
            On Error GoTo 0
        End With
    Next
End Sub
''' <summary>
''' 指定サイズに合わせフォームとコントロールを伸縮する。
''' </summary>
''' <param name="formObj">フォームのオブジェクト</param>
''' <param name="formWidth">フォームの幅</param>
''' <param name="formHeight"フォームの高さ></param>
''' <remarks></remarks>
Sub FormSizeChange(ByVal formWidth As Long, ByVal formHeight As Long)
  'フォームのサイズを変更
  Dim widthRate As Double
  Dim heightRate As Double
  With formObj
        '最大化中はフォームサイズを変更しない
        On Error Resume Next
        widthRate = formWidth / formInfo(.Name)("Width")
        heightRate = formHeight / formInfo(.Name)("Height")
         .Width = formInfo(.Name)("Width") * widthRate
         .Height = formInfo(.Name)("Height") * heightRate
         On Error GoTo 0
    End With
    'フォーム内の全コントロールのサイズと位置を変更
    Dim con As Variant
    For Each con In formObj.Controls
        With con
            .Width = formInfo(.Name)("Width") * widthRate
            .Height = formInfo(.Name)("Height") * heightRate
            .Top = formInfo(.Name)("Top") * heightRate
            .Left = formInfo(.Name)("Left") * widthRate
             '対象プロパティが存在しない場合は無視
             On Error Resume Next
             If widthRate > heightRate Then
                .Font.Size = formInfo(.Name)("FontSize") * heightRate
            Else
                .Font.Size = formInfo(.Name)("FontSize") * widthRate
            End If
             On Error GoTo 0
        End With
    Next
    'フォームの再描画
    DoEvents
    formObj.Zoom = 101
    formObj.Zoom = 100
    DoEvents
End Sub

フォームの大きさを変更するサンプルコード

以下のボタンは「CommandButton1」を押すとフォームサイズが二倍に拡大されるコードです。

適当なユーザフォームに張り付けて実行してください。

Option Explicit
Dim FormResizeClass As New FormResizeClass
''' <summary>
''' フォームとコントロールの初期サイズを記録
''' </summary>
 Private Sub UserForm_Initialize()
     Call FormResizeClass.FormSizeRec(Me)
End Sub
 
 ''' <summary>
''' ボタンを押されるとフォームサイズを200％拡大する
''' </summary>
Private Sub CommandButton1_Click()
    Call FormResizeClass.FormSizeChange(Me.Width * 2, Me.Height * 2)
End Sub
 ''' <summary>
''' ボタンを押されるとフォームサイズを50％縮小する
''' </summary>
Private Sub CommandButton2_Click()
    Call FormResizeClass.FormSizeChange(Me.Width * 0.5, Me.Height * 0.5)
End Sub

関連記事

https://blog.rishia.net/vba-userform-user-resize