t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA ユーザーフォームのテキストボックスのサイズを自動で最適化するマクロ

VBA VBA書籍紹介 ユーザーフォーム

今回の記事は、Excelの表から各列の最大文字数を求め、その文字数に基づいて適切なサイズのテキストボックスを新規フォームに配置するというものである。

記事タイトルからすると既存フォームに対して実行するように思われたかもしれない。
なかなかキャッチーで、かつ簡潔なタイトルが思い浮かばなかったのだ。
だましてごめん。

目次

前談

時々、Excel表をユーザーフォームで扱いたくなる。
特に列数が多いと1レコード見るのに横スクロールで行ったり来たりする必要があるので、フォームがあると便利だ。

イメージとしてはこんな感じ。(普通はラベルも付けるけど今回はパス)
f:id:t-hom:20160225023648p:plain

しかし、表に合わせて最適なフォームをデザインするのは結構面倒だ。何が一番面倒かというと、テキストボックスのサイズと配置である。

最近VBComponentの操作もこなれてきたので、ユーザーフォームのデザインもVBAでやってしまおう。

列ごとの最大文字数を取得する「各列最大文字数」関数を作る。

テキストボックスの大まかなサイズは、中に入れる文字数で決まる。
そこで、各列の最大文字数を取得する関数を作成することにした。

一旦、普通のプロシージャとして作成し、あとで関数化する。

まずは、選択範囲を配列に入れて、ループで列を移動してみよう。
コードは次のとおり。

Sub 各列最大文字数_未完()
    Dim Arr: Arr = Selection.Value
    For i = LBound(Arr, 2) To UBound(Arr, 2)
        Debug.Print Arr(1, i)
    Next
End Sub

このように表全体を選択し、
f:id:t-hom:20160225024635p:plain

上記のマクロを実行すると、イミディエイトウィンドウに次のように出力される。

No
列1
列2
列3
列4
列5

次に、これを改良し、列ごとに要素の文字長を出力してみる。

Sub 各列最大文字数_未完2()
    Dim Arr: Arr = Selection.Value
    For i = LBound(Arr, 2) To UBound(Arr, 2)
        Debug.Print Arr(1, i) 'ヘッダの出力
        For j = LBound(Arr, 1) To UBound(Arr, 1)
            Debug.Print Len(Arr(j, i));
        Next
        Debug.Print '改行
    Next
End Sub

結果はこうなる。

No
 2  1  1  1  1  1  1  1  1  1  2 
列1
 2  16  13  14  9  9  17  5  17  18  16 
列2
 2  52  62  99  53  69  68  74  57  74  63 
列3
 2  1  1  3  3  2  3  3  1  3  3 
列4
 2  4  1  3  1  1  4  2  1  2  2 
列5
 2  192  167  55  283  200  157  123  41  238  143

あとは最大数を取るようにして、関数化しておく。

Function 各列最大文字数(取得範囲 As Range) As String
    Dim ret As String
    Dim Arr: Arr = 取得範囲
    For i = LBound(Arr, 2) To UBound(Arr, 2)
        ret = ret & Arr(1, i) & " "
        Dim MaxLen: MaxLen = 0
        For j = LBound(Arr, 1) To UBound(Arr, 1)
            If MaxLen < Len(Arr(j, i)) Then MaxLen = Len(Arr(j, i))
        Next
        ret = ret & CStr(MaxLen) & ","
    Next
    ret = Left(ret, Len(ret) - 1)
    各列最大文字数 = ret
End Function

「各列最大文字数」関数の使い方

表を選択した状態で、Selectionを引数として関数「各列最大文字数」呼び出してみる。

Sub test()
    Debug.Print 各列最大文字数(Selection)
End Sub

すると、以下のような文字列が取得できる。

No 2,列1 18,列2 99,列3 3,列4 4,列5 283

この文字列は、2種類の区切り文字(カンマとスペース)がある。
まず最初にカンマで区切ると、

Sub test2()
    For Each x In Split(各列最大文字数(Selection), ",")
        Debug.Print x
    Next
End Sub

こうなる。

No 2
列1 18
列2 99
列3 3
列4 4
列5 283

これを更にSplitするとまた配列ができるので、直接添え字を書いて出力してみる。

Sub test3()
    For Each x In Split(各列最大文字数(Selection), ",")
        Debug.Print "「";
        Debug.Print Split(x)(0);
        Debug.Print "」の最大文字数は「";
        Debug.Print Split(x)(1);
        Debug.Print "」文字です。"
    Next
End Sub

※区切り文字のデフォルトがスペースなので、スペース区切りの場合は第二引数を書かなくて良い。

結果はこのようになる。

「No」の最大文字数は「2」文字です。
「列1」の最大文字数は「18」文字です。
「列2」の最大文字数は「99」文字です。
「列3」の最大文字数は「3」文字です。
「列4」の最大文字数は「4」文字です。
「列5」の最大文字数は「283」文字です。

フォームの自動生成

ここからは、以下2点の参照設定が必要になる。

また、マクロのセキュリティ設定でVBA プロジェクト オブジェクト モデルへのアクセスを信頼するのチェックが必要。
（…最近毎回この文言書いている気がする。なんか省力化したい。）

フォームの生成自体はお決まりのパターンなので、以下のサンプルを参考に、あとはループで回すなりなんなりといったところ。

Sub フォーム生成()
    Dim f As UserForm
    Set f = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Designer
    Dim C As Control
    Set C = f.Controls.Add("Forms.TextBox.1")
    C.Top = 10
    C.Left = 20
    C.Height = 15
    C.Width = 300
End Sub

実行すると、こんな感じでフォームが出来上がる。
f:id:t-hom:20160225031551p:plain

残念ながらフォームそのもののサイズをマクロで変更する方法は見つかってないので、マウスで端のハンドルを掴んでサイズ変更しよう。

テキストボックスのサイズを算出する

列ごとの最大文字数の求め方が分かったので、テキストボックスのサイズはその文字数を基準に決めれば良い。
まず一行に何文字入れるかを決める。

これは読みやすい文書の文字数ということでいくつかネットに模範解答が出ている。
https://www.okidata.co.jp/special/tips1/tips10a.htmlwww.okidata.co.jp

ということで、35文字を採用した。

行数は文字数を35で割れば算出できるが、これも画面サイズの都合があるので表示できる行数は制限しておきたい。
今回は適当に最大7行としておいた。(根拠はない)

コードにするとこんな感じ。(断片なのでこれだけでは動かない)

Const 折り返し文字数 = 35
Const 最大表示行数 = 7
行数 = (文字数 \ 折り返し文字数) + 1
If 文字数 > 折り返し文字数 Then 文字数 = 折り返し文字数
If 行数 > 最大表示行数 Then 行数 = 最大表示行数

次に行の高さと文字の幅を調査する。
これは地道に検証を繰り返して、フィット感を確認し、文字幅を9、行高を9.2とした。
画面スケールに影響を受けそうなので、うまくフィットしない場合は別途調整が必要。

完成コード

以下が完成コード。
これだけ見る人もいるかもしれないので繰り返すと、
以下2点の参照設定が必要になる。

また、マクロのセキュリティ設定でVBA プロジェクト オブジェクト モデルへのアクセスを信頼するのチェックが必要。

まずは冒頭で作った関数(以下)を張り付けて、

Function 各列最大文字数(取得範囲 As Range) As String
    Dim ret As String
    Dim Arr: Arr = 取得範囲
    For i = LBound(Arr, 2) To UBound(Arr, 2)
        ret = ret & Arr(1, i) & " "
        Dim MaxLen: MaxLen = 0
        For j = LBound(Arr, 1) To UBound(Arr, 1)
            If MaxLen < Len(Arr(j, i)) Then MaxLen = Len(Arr(j, i))
        Next
        ret = ret & CStr(MaxLen) & ","
    Next
    ret = Left(ret, Len(ret) - 1)
    各列最大文字数 = ret
End Function

次に、表を選択した状態で、
f:id:t-hom:20160225024635p:plain

以下のコードを実行する。

Sub 自動で最適なサイズのテキストボックスを配置()
    Dim 行別文字数 As String
    行別文字数 = 各列最大文字数(Selection)

    Const 全角文字幅 = 9
    Const 行高 = 9.2
    Const 折り返し文字数 = 35 '文字
    Const 最大表示行数 = 7 '行
    Const コントロールマージン = 5
    コントロールY座標 = 20 '(フォーム上端から)
    コントロールX座標 = 20 '(フォーム左端から)

    Dim f As UserForm
    Set f = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Designer
    For Each x In Split(行別文字数, ",")
    
        '文字数と行数を算出
        文字数 = Split(x)(1)
        行数 = (文字数 \ 折り返し文字数) + 1
        If 文字数 > 折り返し文字数 Then 文字数 = 折り返し文字数
        If 行数 > 最大表示行数 Then 行数 = 最大表示行数
        
        'コントロールを配置
        Dim C As Control
        Set C = f.Controls.Add("Forms.TextBox.1")
        With C
            .Name = "txt" & Split(x)(0)
            .Text = Split(x)(0)
            .Width = 15 + (文字数 * 全角文字幅) '15はサイズの微調整
            If 行数 > 1 Then
                .MultiLine = True
            End If
            .Top = コントロールY座標
            .Left = コントロールX座標
            .Height = 5 + (行高 * 行数) '5はサイズの微調整
            コントロールY座標 = コントロールY座標 + .Height + コントロールマージン
        End With
    Next
End Sub

すると、こんな感じでフォームが表示されるので、
f:id:t-hom:20160225033231p:plain

ハンドルを引っ張って適当なサイズに変更する。
f:id:t-hom:20160225033325p:plain

これで完成。
f:id:t-hom:20160225023648p:plain

なお、ラベルを配置したい場合はf.Controls.Add("Forms.Label.1")とする。

おまけ

こういう検証をしていると、フォームを作りすぎて消すのに困る。
削除用マクロも用意した。

実行すると「Are you sure?」と聞かれるので、sureと入力すると、そのワークブックにある全てのユーザーフォームが削除される。
ActiveWorkbookではなく、このマクロを配置したブックのフォームがすべて消えるので注意。

Sub 全フォーム削除()
    If Not "sure" = InputBox("Are you sure?") Then Exit Sub
    Dim x As VBComponent
    For Each x In ThisWorkbook.VBProject.VBComponents
        Set C = x
        If x.Type = vbext_ct_MSForm Then
            ThisWorkbook.VBProject.VBComponents.Remove (C)
        End If
    Next
    MsgBox "Done.", vbInformation
End Sub

フォーム関連のオススメ書籍

知識ゼロから学ぶ Excel VBA プログラミング ユーザーフォーム&コントロール

知識ゼロから学ぶ Excel VBA プログラミング ユーザーフォーム&コントロール

私はこの本で初めて、コードでフォームのコントロールを配置整列できることを知った。
※書籍ではフォームデザイナではなく、FormのInitialize後に整列させる方法が紹介されている。

同じシリーズの以下もおススメ

アプリ作成で学ぶExcelVBAプログラミングユーザーフォーム&コントロール

アプリ作成で学ぶExcelVBAプログラミングユーザーフォーム&コントロール

VBAのフォーム関連ならこの2冊は外せない。

ただ2冊とも一から通しで読むような構成になっているので、それなりに根気がいる。
もう少しざくっと、リファレンス的に使いたいなら以下の書籍がおススメ

かんたんプログラミング Excel 2010 VBA コントロール・関数編

かんたんプログラミング Excel 2010 VBA コントロール・関数編

以上

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。