Excel VBAでフォームを作る際に、項目が多くてウインドウの高さに収まりきらないことがある。
そこで今回はスクロールによってフォーム全体をウインドウに収めるアイデアを紹介する。
言葉では何がやりたいのか伝わりにくいと思うのでまずは動作イメージから。
動作イメージ
注意事項
あくまでアイデアなので、実用化にはまだ色々と工夫が必要になる。
今のままではデータの取り出しすらままならないのだが、本記事のコードを読める人なら自分で実装できると思われる。
コード
クラスモジュール「FieldLocator」
まずはクラスモジュールを挿入し、オブジェクト名をFieldLocatorとする。
このFieldLocatorはデータフィールド用のテキストボックスとそのラベルを生成し、座標を管理するオブジェクトだ。
最初のFieldLocatorから次のFieldLocatorへ、そこからまた次のFieldLocatorへと参照が張られ、とリスト構造(数珠状)でつながる仕組み。
1カラムのテキストボックス、2カラムのテキストボックスのみ対応している。
コードはこちら。
'DEBUG_MODEはラベルを配置するときに色が付いてないとサイズが分かりづらいので作った。 'Falseにすると色付け無しになる。 #Const DEBUG_MODE = False Private top_ As Long Public Left As Long Public FieldName1 As String Public FieldName2 As String Public LabelWidth As Integer Public LineCount As Integer Public L1 As MSForms.Label, L2 As MSForms.Label Public T1 As MSForms.TextBox, T2 As MSForms.TextBox 'すべてのFieldLocatorは最初のアイテムからNextItemを辿って数珠状につながる想定。 'これにより、最初のアイテムのTopプロパティーを変更すると、連鎖的に他のアイテムのTopプロパティーも変わる。 'つまり全てのコントロールが最初のアイテムに連動して動くので、スクロールバーで動かすのは最初のアイテムだけでOKになる。 Public NextItem As FieldLocator Const FONT_SIZE = 12, FONT_HEIGHT = 15, FONT_MARGIN = 6 Private Sub Class_Initialize() Me.LineCount = 1 Me.LabelWidth = 100 End Sub Public Property Get Self() As FieldLocator Set Self = Me End Property Public Function CreateNext() As FieldLocator With New FieldLocator .Top = Me.Bottom + 10 .Left = Me.Left .LabelWidth = Me.LabelWidth Set NextItem = .Self Set CreateNext = NextItem End With End Function Public Property Let Top(t_ As Long) top_ = t_ If Not T1 Is Nothing Then CCnt(T1).Top = t_ CCnt(L1).Top = CCnt(T1).Top + 2 If Not T2 Is Nothing Then CCnt(T2).Top = CCnt(T1).Top CCnt(L2).Top = CCnt(L1).Top End If End If If Not NextItem Is Nothing Then NextItem.Top = Me.Bottom + 10 End If End Property Public Property Get Top() As Long If T1 Is Nothing Then Top = top_ Else Top = CCnt(T1).Top End If End Property Public Property Get Bottom() As Long Bottom = CCnt(T1).Top + CCnt(T1).Height End Property Sub AddInputBox(f As UserForm) Set L1 = f.Controls.Add("Forms.Label.1") L1.Font.Name = "Meiryo UI" L1.Font.Size = FONT_SIZE CCnt(L1).Height = FONT_HEIGHT + FONT_MARGIN CCnt(L1).Width = LabelWidth CCnt(L1).Left = Left L1.TextAlign = fmTextAlignRight L1.Caption = FieldName1 #If DEBUG_MODE Then L1.BackColor = rgbLightYellow #End If Set T1 = f.Controls.Add("Forms.Textbox.1") T1.BorderStyle = fmBorderStyleSingle T1.Font.Name = "Meiryo UI" T1.Font.Size = FONT_SIZE T1.MultiLine = LineCount > 1 T1.ScrollBars = fmScrollBarsVertical T1.EnterKeyBehavior = LineCount > 1 CCnt(T1).Height = FONT_HEIGHT * LineCount + FONT_MARGIN CCnt(T1).Width = 450 CCnt(T1).Left = CCnt(L1).Left + CCnt(L1).Width + 10 CCnt(T1).Top = top_ CCnt(L1).Top = CCnt(T1).Top + 2 End Sub Sub AddTwinInputBox(f As UserForm) Set L1 = f.Controls.Add("Forms.Label.1") L1.Font.Name = "Meiryo UI" L1.Font.Size = FONT_SIZE CCnt(L1).Height = FONT_HEIGHT + FONT_MARGIN CCnt(L1).Width = LabelWidth CCnt(L1).Left = Left L1.TextAlign = fmTextAlignRight L1.Caption = FieldName1 #If DEBUG_MODE Then L1.BackColor = rgbLightYellow #End If Set L2 = f.Controls.Add("Forms.Label.1") L2.Font.Name = "Meiryo UI" L2.Font.Size = FONT_SIZE CCnt(L2).Height = FONT_HEIGHT + FONT_MARGIN CCnt(L2).Width = LabelWidth L2.TextAlign = fmTextAlignRight L2.Caption = FieldName2 #If DEBUG_MODE Then L2.BackColor = rgbLightYellow #End If Set T1 = f.Controls.Add("Forms.Textbox.1") T1.BorderStyle = fmBorderStyleSingle T1.Font.Name = "Meiryo UI" T1.Font.Size = FONT_SIZE T1.MultiLine = LineCount > 1 T1.ScrollBars = fmScrollBarsVertical T1.EnterKeyBehavior = LineCount > 1 CCnt(T1).Height = FONT_HEIGHT * LineCount + FONT_MARGIN CCnt(T1).Width = (450 - 20 - LabelWidth) / 2 CCnt(T1).Left = CCnt(L1).Left + CCnt(L1).Width + 10 CCnt(T1).Top = top_ CCnt(L1).Top = CCnt(T1).Top + 2 CCnt(L2).Left = CCnt(T1).Left + CCnt(T1).Width + 10 CCnt(L2).Top = CCnt(L1).Top Set T2 = f.Controls.Add("Forms.Textbox.1") T2.BorderStyle = fmBorderStyleSingle T2.Font.Name = "Meiryo UI" T2.Font.Size = FONT_SIZE T2.MultiLine = LineCount > 1 T2.ScrollBars = fmScrollBarsVertical T2.EnterKeyBehavior = LineCount > 1 CCnt(T2).Height = FONT_HEIGHT * LineCount + FONT_MARGIN CCnt(T2).Width = CCnt(T1).Width CCnt(T2).Left = CCnt(L2).Left + CCnt(L2).Width + 10 CCnt(T2).Top = top_ End Sub Private Function CCnt(o As Object) As MSForms.Control Set CCnt = o End Function
フォームモジュール
ユーザーフォームを挿入し、次のコードを張り付ける。
フォームのオブジェクト名は任意で良い。
Dim FirstField As FieldLocator Private WithEvents ScrollBar1 As MSForms.ScrollBar Private Sub ScrollBar1_Change() 'ScrollBarはマイナス値をMaxに設定すると、増分がマイナスになるので、 '次のようにシンプルに書ける。 FirstField.Top = ScrollBar1.Value End Sub Private Sub UserForm_Initialize() Set ScrollBar1 = Me.Controls.Add("Forms.ScrollBar.1") Const GOLDEN_RATIO = 1.618 Me.Width = 800 '所有してるモニタの最低解像度の横幅が800(SVGA)なので。ちなみに最高は1920。 Me.Height = Me.Width / GOLDEN_RATIO '黄金比を用いて収まりよく。 ScrollBar1.Width = 20 ScrollBar1.Left = Me.Width - 25 ScrollBar1.Height = Me.Height - 22 ScrollBar1.SmallChange = 5 ScrollBar1.LargeChange = 20 With New FieldLocator '最初の作成で設定する Set FirstField = .Self .Top = 30 ScrollBar1.Min = .Top .Left = 100 .LabelWidth = 80 '以降の設定項目は共通 .FieldName1 = "件名" .LineCount = 1 'LineCountは省略すると1になる。 .AddInputBox Me 'これは1カラムの入力フィールドを追加するコマンド '以降はCreateNextのメソッドチェーンでFieldLocatorを数珠状に作っていく。 With .CreateNext .FieldName1 = "概要" .LineCount = 2 .AddInputBox Me With .CreateNext .FieldName1 = "詳細" .LineCount = 10 .AddInputBox Me With .CreateNext '2カラムの入力フィールドの場合はこうする。 .FieldName1 = "開始日" .FieldName2 = "有効期限" .AddTwinInputBox Me With .CreateNext .FieldName1 = "担当者" .AddInputBox Me With .CreateNext .FieldName1 = "連絡先" .AddInputBox Me With .CreateNext .FieldName1 = "備考欄" .LineCount = 10 .AddInputBox Me With .CreateNext .FieldName1 = "その他" .AddInputBox Me '最後の要素のBottomを利用してScrollBarのMax値 '(プロパティ名はMaxだが、実際にはマイナス値なので最小)を決定する。 ScrollBar1.Max = Me.Height - .Bottom - 30 'メソッドチェーンが終わると、残念ながら大量のEnd With文 End With: End With: End With: End With: End With: End With: End With: End With End Sub
フォーム自体を除き、パーツはすべてコードで生成する為、フォーム上には何も配置しなくて良い。
サイズもコードで指定するのでそのままで良い。
フォームを起動すると冒頭の動作イメージのとおり操作できる。
あとがき
Access Formを使えばこんなことは朝飯前なんだけど、Excelにちょっとしたフォームが欲しくなることもある。
標準のフォーム機能ってのもあった気がするけど、使い勝手がとても悪いので、自作を試みているところ。
ちょっとしたフォームにしては作り方が大掛かりに見えるかもしれないが、使いまわしができ、デザインの微調整が必要なく、単に項目を指定していくだけで完成する汎用的なフォーム作成が目的なので、この手間は仕方がない。
おまけ
以下はスクロールバーをMin 0% Max 100%のパーセンテージで管理しようともがいてる図。
結局、Maxをマイナス値にするとマイナスに向かって進むことが判明し、コードをよりシンプルに出来るのでパーセンテージ管理は没になった。
以下はHeight Managerというオブジェクトでラベルとテキストボックスを管理し、双方向ポインタで結ぶことで先頭を動かすと全体が動く仕組みを作ろうとした図。
このアイデアは別の形(FieldLocator)で実現した。実際には片方向ポインタで十分だった。
上下のボーダーを跨ぐとコントロールを非表示にするアイデアだったが実装に至っていない。
現在はスクロールによってフォームの上端・下端でコントロールが見えなくなるが、本当はZOrderをトップにしたラベルの下に潜り込ませて、完全に潜ったらHiddenにしようと考えている。ちょっと管理すべき項目が多くて混乱中。