ExcelVBAで使用するユーザフォームについて、動的にコントロールの数を変更したいときがあるかと思います。
例えば入力に使用するテキストボックスの数が定まっていない場合などです。(予め大量に用意しておく方法でも対応はできますが…)
単純にテキストボックスを追加していくだけなら簡単だったのですが、イベントを追加しようと思ったところ存外苦戦しました。
対応した内容について備忘のために記載しておこうと思います。
今回VBAで作成した動的なユーザフォーム
動的なユーザフォームと言っても色々な仕様があるかと思います。(例えば、数値を入力したらその分増えるとか)
今回はシンプルに「+」ボタンを押すとテキストボックスが増えていくタイプのものを作成しました。
汎用的に使えるものではないと思うので、需要があるかわかりませんが、作成したものは以下にアップロードしてみました。
フォーム上の設定とコード
上記で作成したプログラムのコードとフォーム上のコントロール設定は以下の通りとなります。
まずフォーム上のコントロール設定ですが、初期配置されているテキストボックスのオブジェクト名を「TextBox1」としました。
追加ボタン(+ボタン)のオブジェクト名は「plus」に設定しています。
(画面に見える確認ボタンはテスト用のボタンなので割愛)
次にフォームのコードは以下のようになります。
Private textList() As MSForms.TextBox
Private template As MSForms.TextBox
Private Sub test_Click()
For Each txt In textList
MsgBox txt.Value
Next txt
End Sub
Private Sub UserForm_Initialize()
' 初期設定されているテキストボックスをテンプレートに指定
Set template = TextBox1
ReDim textList(0)
Set textList(0) = template
End Sub
' テキストボックスを新しく追加する
Private Sub plus_Click()
' テキストボックス新規作成
Dim newText As MSForms.TextBox
Set newText = Me.Controls.Add("Forms.TextBox.1", "TextBox" & UBound(textList), True)
' 新しく追加するテキストボックスの大きさ指定
With newText
.Top = template.Top + (UBound(textList) + 1) * template.Height
.Left = template.Left
.Height = template.Height
.Width = template.Width
End With
ReDim Preserve textList(UBound(textList) + 1)
Set textList(UBound(textList)) = newText
End Sub
フォールロード時に初期配置されているテキストボックスをtemplateという変数に格納しています。
追加ボタンが押された時に、templateの位置情報などをもとに新しいテキストボックスを作成しています。
値の処理をしやすいようにテキストボックス達はtextListという配列に格納しています。なのでテキストリストのすべての値を参照するときは、textListをループさせればよいです。
追加されるコントロールにイベントを追加する
次に動的に追加されるコントロールにイベントを設定する場合を作成してみます。
イベントとは、Click(クリックされた時)、Change(値が変更された時)などに発火させる処理のことです。
VBAではVBと違ってAddHundlerでイベントをコントロールに追加するのが難しそうなので、どのように対処すればよいか悩みました。
結論として、クラスモジュールとWithEventsを使用することで実現することができました。
今回は例として、「値を変更したら0が入力される」というイベントを実装してみました。作成したコードが以下になります。
まず、WrapTextというクラスを作成します。
Private WithEvents wrap As MSForms.textBox
Public Property Get textBox() As MSForms.textBox
Set textBox = wrap
End Property
Public Sub bind(origin As MSForms.textBox)
Set wrap = origin
End Sub
Private Sub wrap_Change()
' 値を変更したら0が入力される
wrap.Value = "0"
End Sub
次にWrapTextを使用するコードを作成します。
Private textList() As WrapText
Private template As New WrapText
Private Sub test_Click()
For Each txt In textList
MsgBox txt.Value
Next txt
End Sub
Private Sub UserForm_Initialize()
' 初期設定されているテキストボックスをテンプレートに指定
Call template.bind(TextBox1)
ReDim textList(0)
Set textList(0) = template
End Sub
' テキストボックスを新しく追加する
Private Sub plus_Click()
' テキストボックス新規作成
Dim newText As MSForms.textBox
Set newText = Me.Controls.Add("Forms.TextBox.1", "TextBox" & UBound(textList), True)
Dim newWrapText As New WrapText
Call newWrapText.bind(newText)
Dim templateTxt As Object
Set templateTxt = template.textBox
' 新しく追加するテキストボックスの大きさ指定
With newText
.Top = templateTxt.Top + (UBound(textList) + 1) * templateTxt.Height
.Left = templateTxt.Left
.Height = templateTxt.Height
.Width = templateTxt.Width
End With
ReDim Preserve textList(UBound(textList) + 1)
Set textList(UBound(textList)) = newWrapText
End Sub
WrapTextクラスの中でWithEventsを使用してテキストボックスにイベントを追加しています。
コメントを残す