ListBoxを操作するクラスモジュール　⑥ 列幅を自動調整

ListBoxを操作するクラスモジュールを、私なりに作成中。
前回は、検索値を含む行のみでリストボックスを更新してみた。
infoment.hatenablog.com

今日も、前回の続きから。
f:id:Infoment:20201006225720p:plain

リストボックスで何かと面倒なのが、列幅の調整だ。
複数列ある場合は下記のように、列幅のポイント数をセミコロン（；）で
繋いで設定する。
f:id:Infoment:20201006225912p:plain

しかし文字数が可変の場合、どうしても見切れてしまったり、逆に大きな
余白が出来てしまい、調整が何かと面倒だ。

そこで今回は、文字数から良い感じに列幅を調整することに挑戦してみた。

といっても、やり方は至極単純。各列の最大文字数を元に、列幅を求める
というもの。

クラスモジュール（ListBoxControl）

今回は、以下の二つを追加した。

各列の幅（ポイント数）を格納した配列。
１．を「；」で結合したもの。

１と２を分けた理由は、リストボックスの幅調整に利用できるかもと思ったから。でも結局、そんな機会は来ないかも。

' 列幅自動調整用。
' メイリオで最適化している。
' フォントサイズ×最大文字バイト数×1.5を、幅のポイント数とする。
Private Property Get ColumnWidthArray() As Variant
    Dim arr() As Variant
    ReDim arr(UBound(LatestListArray, 2))
    Dim Temp As Double
        For j = 0 To UBound(LatestListArray, 2)
            For i = 0 To UBound(LatestListArray)
                Temp = Len(LatestListArray(i, j)) * TargetListBox.Font.Size * 1.5
                If arr(j) < Temp Then
                    arr(j) = Temp
                End If
            Next
            ' 文字数が多いほど、幅を少し狭くすると丁度良くなる。
            ' 下記の数式は色々試した経験則なので、不適当な場合も充分ありうる。
            arr(j) = arr(j) * 0.998 ^ arr(j)
        Next
        
        ColumnWidthArray = arr
End Property

Private Property Get ColumnWidthValue() As String
    ColumnWidthValue = Join(ColumnWidthArray, ";")
End Property

リストボックスにリストをセットするメソッドには、以下を追加した。

列数を自動設定するフラグ
列幅を自動調整するフラグ

' リストボックスにリストをセット。
Public Sub InitializeList(ByVal source_list_array As Variant, _
                 Optional column_number_autofit As Boolean = False, _
                 Optional column_width_autofit As Boolean = False)

    ' 仮の配列。
    Dim Temp As Variant
        ' list_arrayが配列なら、そのままTempにセット。
        ' 配列でないならば、一旦配列化したのちセット。
        If IsArray(source_list_array) Then
            Temp = source_list_array
        Else
            Temp = Array(source_list_array)
        End If
        TargetListBox.List = Temp
    
        ' 配列のインデックスについて、最小値を一旦
        ' 「1」としたい。
        ' 配列が一次元の場合、Transpose関数で一旦行列を反転させると、
        ' インデックスの最小値が１の、複数行１列の二次元配列になる。
        Temp = WorksheetFunction.Transpose(Temp)
        
        ' 二次元目のインデックス最大値が１で無い場合、配列は元から
        ' 二次元配列ということになる。したがって、行列を反転して元に戻す。
        ' またこの時点で、元の配列のインデックス最小値が何であっても、
        ' 行と列ともに１から始まる配列となる。
        If UBound(Temp, 2) <> 1 Then
            Temp = WorksheetFunction.Transpose(Temp)
            DimensionNumber = 2
        End If
        
        ' リストボックスのリストと同じ構成の二次元配列を作成する。
        ' リストボックスは行列共に０始まりであるため、下記でその
        ' ギャップを解消している。
    ReDim SourceListArray(UBound(Temp) - 1, UBound(Temp, 2) - 1)
        For i = 0 To UBound(SourceListArray)
            For j = 0 To UBound(SourceListArray, 2)
                SourceListArray(i, j) = Temp(i + 1, j + 1)
            Next
        Next
        
        ' 初回であるため、最新のリストを元のリストとする。
        LatestListArray = SourceListArray

        ' 列数調整。
        If column_number_autofit Then
            TargetListBox.ColumnCount = UBound(LatestListArray, 2) + 1
        End If

        ' 列幅調整。
        If column_width_autofit Then
            TargetListBox.ColumnWidths = ColumnWidthValue
            TargetListBox.Width = WorksheetFunction.Sum(ColumnWidthArray)
        End If
End Sub