ユーザーフォームのサイズ変更 ④ 画像の数だけユーザーフォームを作成

昨日は、ユーザーフォームに画像を表示させてみた。
infoment.hatenablog.com

今日は、複数枚の画像を、ユーザーフォームに表示してみる。

毎回Canvaからダウンロードしている無償画像を、４つ準備した。

今回の作戦は、こうだ。

1. 指定フォルダ内のファイルパスを取得する。
2. ファイルパス毎にユーザーフォームを起動し、画像を表示する。

Sub Test()
    ' 画像ファイル取得用。
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
    
    ' 画像ファイル保存場所。
    Const SorceFolder As String = "C:\Temp"
    
    ' ファイルパス格納用コレクション。
    Dim myFiles As Collection
    Set myFiles = New Collection
    
    ' ファイルパス格納処理。
    Dim File As Scripting.File
        For Each File In FSO.GetFolder(SorceFolder).Files
            myFiles.Add File.Path
        Next
    
    ' コレクションのアイテムの数だけユーザーフォーム作成。
    Dim UFs() As UserForm1
    ReDim UFs(1 To myFiles.Count)
    Dim i As Long
        For i = 1 To myFiles.Count
            Set UFs(i) = New UserForm1
                UFs(i).Show vbModeless
                ' イメージコントロールに画像ファイル設定。
                UFs(i).Image1.Picture = LoadPicture(myFiles(i))
                ' ユーザーフォームのサイズ指定。
                UFs(i).SpinButton1.Value = 2
        
                ' ユーザーフォームの整列。
                UFs(i).Top = 150
                UFs(i).Left = (i - 1) * UFs(i).Width
        Next
End Sub

複数表示に伴い、ユーザーフォーム側のコードも調整した。
調整箇所・・・Userform1 ⇒ Me に置き換える、など。
　　　　　　　これを行わないと、上手くサイズ変更できなかった。

Option Explicit

Private Property Get unit_width() As Long
' ユーザーフォームの単位幅。
' スピンボタンを押すたびに、この値の倍数で
' ユーザーフォームの幅を変化させる。
    unit_width = ActiveWindow.Width / 12
End Property

' 約数を求める関数。
' 約数を求めたい関数を１から順に割り、
' 余りが０の値を約数として辞書に格納する。
' ※MicroSoft Scripting Runtime 参照済み。
Private Function Devisor(source_number As Long) As Scripting.Dictionary
    Dim Dict As Scripting.Dictionary
    Set Dict = New Scripting.Dictionary
    Dim i As Long
    Dim Counter As Long: Counter = 1
        For i = 1 To source_number
            If source_number Mod i = 0 Then
                Dict(Counter) = i
                Counter = Counter + 1
            End If
        Next
        Set Devisor = Dict
End Function

Private Sub SpinButton1_Change()
    Static Dict As Scripting.Dictionary
        If Dict Is Nothing Then
            Set Dict = Devisor(12)
        End If

    ' ユーザーフォームのサイズ変更。
    ' 高さは、高さの約71％（１／√２倍）とした。
    ' ※馴染みのあるＡサイズ（A3やA4など）の比率。
    Me.Width = unit_width * Dict(SpinButton1.Value)
    Me.Height = Me.Width / 2 ^ 0.5
    
    With Image1
        .Width = Me.Width - 30
        .Height = Me.Height - 72
        .Top = 40
        .Left = 10
    End With
End Sub

Private Sub UserForm_Initialize()
    ' スピンボタンの最大値と最小値を設定。
    SpinButton1.Min = 1
    SpinButton1.Max = 6
End Sub

試してみた結果がこちら。

調整に思った以上に時間が掛かったため、今日はここまで。
明日に続きます。

参考まで。