【VBA】ユーザフォームに動的にコントロールを追加する

ExcelVBAで使用するユーザフォームについて、動的にコントロールの数を変更したいときがあるかと思います。

例えば入力に使用するテキストボックスの数が定まっていない場合などです。(予め大量に用意しておく方法でも対応はできますが…)

単純にテキストボックスを追加していくだけなら簡単だったのですが、イベントを追加しようと思ったところ存外苦戦しました。

対応した内容について備忘のために記載しておこうと思います。

今回VBAで作成した動的なユーザフォーム

動的なユーザフォームと言っても色々な仕様があるかと思います。(例えば、数値を入力したらその分増えるとか)

今回はシンプルに「+」ボタンを押すとテキストボックスが増えていくタイプのものを作成しました。

汎用的に使えるものではないと思うので、需要があるかわかりませんが、作成したものは以下にアップロードしてみました。

https://vbaexcel.slavesystems.com/product/%E5%8B%95%E7%9A%84%E3%83%95%E3%82%A9%E3%83%BC%E3%83%A0sample.xlsm

フォーム上の設定とコード

上記で作成したプログラムのコードとフォーム上のコントロール設定は以下の通りとなります。

まずフォーム上のコントロール設定ですが、初期配置されているテキストボックスのオブジェクト名を「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を使用してテキストボックスにイベントを追加しています。


コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)