[ExcelVBA] UserForm上で複数コントロールを動的に追加&イベント検出する

[ExcelVBA] UserForm上で複数コントロールを動的に追加&イベント検出する

ExcelVBAのフォームで、コントロールを動的に作成していくことってできないのかなと思って調べてまとめました。クラスを使えばイベントも拾えるので、いろいろ使えるかもしれません。


背景

VBAで作ったシステムで、UserFormがこんな感じになってるのがあって。赤字がコントロール名で、最後のXが下に行くごとに連番になってるような。

各10個だったので、まあまあめんどくさかったですけど、コントロール名を1個ずつ設定して、それに対してクラスを使ってChangeイベントを拾って、ということをしてました。

そしたら仕様変更があって、ここの数もうちょい増やせない? という話に。あっ、めんどくさそうな予感! 多めに見積もったら100ほしいって! マジか!!

イベント処理のためにコントロール名が「文字列&連番」という形になっててほしいので、当初、TextBoxをコピペで100個くらい作っておいて、

For i = 1 To 100
  Me("TextBox" & i).Name = "hogehoge" & i
Next i

こういうことはできないのかなー、と試してみたのですが、実行時にNameプロパティの変更はできないぜって怒られました。考えてみりゃ、そりゃそうか。

それで他の方法を探してたら、コントロールを追加するAddメソッドのページにたどり着きまして、

ここの最後のほうに書いてあるんですが、

コントロールの Name プロパティを実行時に変更できるのは、Add メソッドで実行時にそのコントロールを追加した場合だけです。

おお、これだ!! という流れです。

実装

フォームの高さ設定

まずは100個ずらーっと並んでもいいように、ユーザーフォームにスクロールバーをつけてやります。フォームのプロパティでこのように。

「ScrollHeight」がスクロールできる高さになります。

フォーム読み込み時にコントロールを追加

コントロールを描写したいフォームモジュールに以下のように書きます。フォームの名前はEditFormにしてあります。

フォームモジュール(EditForm)

Private Const MAX_CONTROL_NUMBER = 100

Private Sub UserForm_Initialize() 'フォーム読み込み時
  Dim newLabel As MSForms.Label
  Dim newText As MSForms.TextBox
  Dim newCheck As MSForms.CheckBox
  
  Dim i As Long
  For i = 1 To MAX_CONTROL_NUMBER
    'ラベル(タイトル)
    Set newLabel = Me.Controls.Add("Forms.Label.1", "ctlLabelTitle" & i) '名前をつけてラベルを追加
    With newLabel
      .Caption = "タイトル" & i 'キャプション
      .AutoSize = True 'サイズは自動
      .Left = 20 '左からの距離
      .Top = 22 + (i - 1) * 20 '上からの距離(始点から20pxずつズレる)
    End With
    
    'テキストボックス(ロット)
    Set newText = Me.Controls.Add("Forms.TextBox.1", "ctlTextLot" & i) '名前をつけてテキストボックスを追加
    With newText
      .Width = 80
      .Height = 18
      .Left = 60
      .Top = 17 + (i - 1) * 20
    End With
    
    'テキストボックス(数量)
    Set newText = Me.Controls.Add("Forms.TextBox.1", "ctlTextQty" & i) '名前をつけてテキストボックスを追加
    With newText
      .Width = 30
      .Height = 18
      .Left = 145
      .Top = 17 + (i - 1) * 20
    End With
    
    'チェックボックス(フラグ)
    Set newCheck = Me.Controls.Add("Forms.checkBox.1", "ctlCheckFlg" & i) '名前をつけてチェックボックスを追加
    With newCheck
      .Value = False '初期値をオフにしておく
      .Width = 13
      .Height = 13
      .Left = 180
      .Top = 20 + (i - 1) * 20
    End With
  Next i
End Sub

1行目が繰り返し描写したいコントロールの総数。ラベル、テキストボックス2つ、チェックボックスを100個描写します。位置や大きさはお好みで。

標準モジュール

Sub test()
  EditForm.Show
End Sub

標準モジュールにフォーム表示のコードを書きます。

実行してみればこんな感じに。ちゃんと100個できます。フォームのScrollHeightが足りないと切れちゃうので調節してください。(やってみたら全然1000じゃ足らなかった!)

これで、動的に配置された各コントロールも、名前はちゃんと文字列&数値になってるので、

For i = 1 To MAX_CONTROL_NUMBER
  If Me("ctlTextLot" & i).Value = "" Then
    MsgBox "空白があります"
    Exit Sub
  End If
Next i

こんな感じにチェックしたりできます。

動的追加されるコントロールのイベントを検出する

右側列のテキストボックスのイベントを拾って、変更されたときになにか動くようにしてみましょう。EventClassという名前のクラスモジュールを作ります。

クラスモジュール(EventClass)

Private WithEvents tgtCtrl As MSForms.TextBox

Public Sub SetCtrl(new_ctrl As MSForms.TextBox)
  Set tgtCtrl = new_ctrl
End Sub

Private Sub tgtCtrl_Change() '数量変更
  MsgBox "コントロール名: " & tgtCtrl.Name & vbNewLine & _
         "値: " & tgtCtrl.Value

  Dim i As Long: i = Replace(tgtCtrl.Name, "ctlTextQty", "") '数値だけ取得しちゃえば
  EditForm("ctlCheckFlg" & i).Value = True '同じ行のコントロールの操作もできちゃう
End Sub

テキストボックスの動きを定義しておきます。必要であればラベルでもチェックボックスでもOK。

7~13行目がChangeイベントのときに走るプロシージャで、変更されたテキストボックスのコントロール名と値をメッセージボックスに出します。コントロール名から数値だけ取り出せば、同じ行の他コントロール(ここではチェックボックス)の操作が可能です(11~12行)。

フォームモジュール(EditForm)

Private Const MAX_CONTROL_NUMBER = 100
Private ctrl(1 To MAX_CONTROL_NUMBER) As New EventClass

Private Sub UserForm_Initialize() 'フォーム読み込み時
  Dim newLabel As MSForms.Label
  Dim newText As MSForms.TextBox
  Dim newCheck As MSForms.CheckBox
  
  Dim i As Long
  For i = 1 To MAX_CONTROL_NUMBER
    'ラベル(タイトル)
    Set newLabel = Me.Controls.Add("Forms.Label.1", "ctlLabelTitle" & i) '名前をつけてラベルを追加
    With newLabel
      .Caption = "タイトル" & i 'キャプション
      .AutoSize = True 'サイズは自動
      .Left = 20 '左からの距離
      .Top = 22 + (i - 1) * 20 '上からの距離(始点から20pxずつズレる)
    End With
    
    'テキストボックス(ロット)
    Set newText = Me.Controls.Add("Forms.TextBox.1", "ctlTextLot" & i) '名前をつけてテキストボックスを追加
    With newText
      .Width = 80
      .Height = 18
      .Left = 60
      .Top = 17 + (i - 1) * 20
    End With
    
    'テキストボックス(数量)
    Set newText = Me.Controls.Add("Forms.TextBox.1", "ctlTextQty" & i) '名前をつけてテキストボックスを追加
    With newText
      .Width = 30
      .Height = 18
      .Left = 145
      .Top = 17 + (i - 1) * 20
    End With
    ctrl(i).SetCtrl newText 'このコントロールをイベント検出させる
    
    'チェックボックス(フラグ)
    Set newCheck = Me.Controls.Add("Forms.checkBox.1", "ctlCheckFlg" & i) '名前をつけてチェックボックスを追加
    With newCheck
      .Value = False '初期値をオフにしておく
      .Width = 13
      .Height = 13
      .Left = 180
      .Top = 20 + (i - 1) * 20
    End With
  Next i
End Sub

さっきのフォームのコードにハイライト部分を追加。数量用のテキストボックスにだけ適用されます。

結果

実行して、適当な場所に変更を加えるとメッセージボックスが開きます。

メッセージボックスを閉じると、同じ行のチェックボックスがオンに。

ただ、テキストボックスのChangeイベントは一文字変更されるごとに走ってウザいので、実用ではもうちょい工夫したほうがいいかもです。

公開日:2018/05/02

6件のコメント

  1. PAO より:

    お世話になります。
    すばらしい投稿誠にありがとうございます。

    すみません、「動的追加されるコントロールのイベントを検出する」を実行したいと思ったのですが、実行方法がわかりませんでした。

    クラスモジュールに「クラスモジュール(EventClass)」をコピペしまして、
    ユーザーフォームモジュールに「フォームモジュール(EditForm)」をコピペし、実行してみたのですが
    ダメでした。

    大変お手数おかけしてしまいますが、ご教示頂くことできますでしょうか?

  2. PAO より:

    お世話になります。

    クラスモジュールを「EventClass」、フォームモジュールを「EditForm」
    と修正しておりませんでした。

    無事動きました。本当にありがとうございました

    • *you より:

      PAOさん、コメントありがとうございます。無事動いたようでなによりです。お役にたてて嬉しいです!

  3. PAO より:

    度々申し訳ございません。 下記サンプルコードのお蔭様で、クラスモジュール(EventClass)で、下記コードによって、同じ行のチェックボックスにㇾマークを入れることができることは理解することができました。

    Dim i As Long: i = Replace(tgtCtrl.Name, “ctlTextQty”, “”) ‘数値だけ取得しちゃえば EditForm(“ctlCheckFlg” & i).Value = True ‘同じ行のコントロールの操作もできちゃう

    次に、
    チェックボックスにㇾマークを入れたら、同じ行のラベルの .Caption = “タイトル” & iのコメントを、Worksheets(“Sheet1”)の 第1列、第i行目に 記入したいと思い、色々Web検索したのですが、結局、
    わかりませんでした。

    苦し紛れに、” Worksheets(“Sheet1”).Cells(val(i), 3) = Me.ctlLabelTitle1.Caption”と書いてみましたが、 やはりエラーが出てしまいました。

    大変申し訳ございませんが、ご教示いただければ幸いでございます。

  4. PAO より:

    お問い合わせした直後に、誠に申し訳ございません。
    再度、PAKUTASO様のサンプルコードをじっくり観察しましたところ、
    下記コードで希望の事ができました。

    Worksheets(“Sheet1”).Cells(i, 3) = (UserForm2(“ctlLabelTitle” & i).Caption)

    私は、ユーザーフォームの名称を、”EditForm”ではなく、”UserForm2″のままにしていた為、
    うまくいかなかったようです。

    PAKUTASO様のおかげで、使いやすいユーザーフォームを作れるようなきっかけとなりました。
    本当にありがとうございます。

    • *you より:

      PAOさん、また間に合わずにすみません。でもご自分で解決できたほうが絶対ご自身の力になりますので、よかったです~!


コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください

コメントは承認制ですので、反映までしばらくお待ち下さい。(稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。)