ExcelVBA 　ユーザーフォーム関連

::: note warn
自分用のメモなので、形は整ってないです。
:::
### ユーザーフォーム　基本
```
*******************       標準モジュール      ****************

Private Sub Showform1()

  Load Form1  '  メモリ上にForm1を読み込む。表示はしない
  Form1.txt1.Text = "FFF"   ' Form1のTextBox1のテキストを設定。Showの後ではできない
  
  Form1.Show
  ' Form1を表示。コードの実行はここで一時停止するみたい。Formが閉じられると実行再開
  
  MsgBox "OK"
  
  
  Form1.Hide   ' Form1を非表示にする
  Unload Form1   ' Form1をメモリ上から削除する。同時に非表示になる
  
End Sub

Private Sub Showform2()
  Form1.Show vbModeless    ' モードレス表示(Formを表示したままEXCELの操作が可能)
End Sub

Private Sub Showform3()
  Form1.Show vbModal   ' モーダル表示(Formを表示したままEXCELの操作不可)
End Sub


*****************     Form1のコード   *****************************

Private Sub btn1_Click()
  With Me
    .StartUpPosition = 0  ' Formの表示位置を上端・左端からに指定する
    .Left = 20
    .Top = 50
    .Height = 200   ' Formの高さ
    .Width = 300   ' Formの幅
  End With
End Sub
```
### Formの表示位置の指定
```
Private Sub btn1_Click()
    With Form1
        .StartUpPosition = 0  ' Formの表示位置を上端・左端からに指定する
        .Left = 20
        .Top = 50
        .Height = 200   ' Formの高さ
        .Width = 300   ' Formの幅
    End With
End Sub
```
### コマンドボタン
```
※ユーザフォーム1.xlsm  BtnFormフォーム

Private Sub btn1_Click()

  With Me.btn2
    If .Enabled Then
      .Enabled = False   ' ボタンを無効にする
      .Visible = False   ' ボタンを非表示にする
    Else
      .Enabled = True   ' ボタンを有効にする
      .Visible = True   ' ボタンを表示する
    End If
  End With
  
End Sub

Private Sub btn2_MouseDown(ByVal Button As Integer, _
  ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' ボタンの上にマウスカーソルがある時に、マウスのボタンが押された時のイベント

  Select Case Button
  Case 1
    MsgBox "左ボタンが押されました"
  Case 2
    MsgBox "右ボタンが押されました"
  End Select
  
End Sub
```
### テキストボックス
```
※ユーザフォーム1.xlsm  TxtFormフォーム

********   IMEModeプロパティの設定値

fmIMEModeNoControl      IME を制御しません (既定値)。
fmIMEModeOn             IME をオンにします。
fmIMEModeOff            IME はオフの状態です。英語モード。
fmIMEModeDisable        IME をオフにします。ユーザーはキーボードで IME をオンにできません。
fmIMEModeHiragana       全角ひらがなモードで IME をオンにします。
fmIMEModeKatakana       全角カタカナ モードで IME をオンにします。
fmIMEModeKatakanaHalf   半角カタカナ モードで IME をオンにします。
fmIMEModeAlphaFull      全角英数字モードで IME をオンにします。
fmIMEModeAlpha          半角英数字モードで IME をオンにします。
fmIMEModeHangulFull     全角ハングル モードで IME をオンにします。
fmIMEModeHangul         半角ハングル モードで IME をオンにします。


***********　  各プロパティ   *******************

テキストの色は、ForeColorの設定色で決まる

Private Sub btn1_Click()

  Me.txt1.Text = "テキスト1"   ' テキストボックスのテキストを設定
  Me.txt2.Value = "テキスト2"  'テキストボックスの場合、.Text と .Value は同じらしい
  Me.txt3 = "テキスト3"        'これでも一応OK
  
  Debug.Print Me.txt1.Text
  Debug.Print Me.txt1.Value
  Debug.Print Me.txt2.Text
  Debug.Print Me.txt2.Value
  Debug.Print Me.txt3.Text
  Debug.Print Me.txt3.Value

End Sub


Private Sub btn2_Click()

'txtに何も入力しない状態で実行してみる

  Debug.Print Me.txt1.Text
  Debug.Print Me.txt1.Value
  
  If Me.txt1.Text = "" Then
    Debug.Print "Textは空文字"
  Else
    Debug.Print "Textは空文字以外"
  End If
  
  If Me.txt1.Value = "" Then
    Debug.Print "Valueは空文字"
  Else
    Debug.Print "Valueは空文字以外"
  End If
  
  '.Text も .Valueも空文字になる

End Sub


Private Sub btn3_Click()
  
  'txt1に、適当な文字列を入力して
  
  With Me.txt1
    MsgBox "カーソル位置： " & .SelStart         ' カーソルのある位置(0番目～で、何文字目か)を取得
    MsgBox "選択している範囲の文字数： " & .SelLength  ' 選択している範囲の文字数を取得
  End With

End Sub


Private Sub btn4_Click()

  'txt1に、10文字くらいの文字列を入力して

  With Me.txt1
    .SelStart = 0
    .SelLength = 5
    .SelText = "BBB"
    ' 1文字目から5文字分を選択し、選択部分のテキストを"BBB"に変更する
  End With

End Sub



Private Sub btn5_Click()

  ' パスワード入力用テキストボックスで、パスワードを間違った場合に再入力をしやすくする
  With Me.txt1
    If .Text <> "pass01" Then  ' パスワードが間違っている場合
      MsgBox "パスワードが違います"
      .SetFocus   ' テキストボックスにフォーカス
      .SelStart = 0
      .SelLength = Len(Me.txt1)  ' テキストボックスの文字列全体を選択
    Else
      MsgBox "正しいパスワードです"
    End If
  End With

End Sub



'全てのキーが押された時に発生するイベント
Private Sub txt4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  MsgBox "KeyDown キーNo： " & KeyCode
End Sub


'ASCIIキーが押された時に発生するイベント
Private Sub txt5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  MsgBox "KeyPress キーNo： " & KeyAscii
End Sub
```
### チェックボックス
```
※ユーザフォーム1.xlsm  ChkFormフォーム

************   プロパティ  ********

Value = True           チェックがある
Value = False          チェックが無い
Value = vbNullString    半押し(On/OFFの中間)  Value = Nullになる


Enabled = True    コントロールが使用可能
Enabled = False   コントロールが使用不可

TripleState = True   ON・OFF・Null の3つの状態を持つようにする(半透明の状態がNull)




Private Sub btn1_Click()  'チェックの有無の取得

  If Me.chk1.Value Then
    MsgBox "chk1はチェックが入っています"
  Else
    MsgBox "chk1はチェックが入っていません"
  End If

End Sub


Private Sub btn2_Click()  '使用可能/使用不可の切り替え

  If Me.chk1.Enabled Then
    Me.chk1.Enabled = False
  Else
    Me.chk1.Enabled = True
  End If
  
  If Me.chk2.Enabled Then
    Me.chk2.Enabled = False
  Else
    Me.chk2.Enabled = True
  End If

End Sub

Private Sub btn3_Click()  ' ON・OFF・Null の3つの状態を持つようにする

  Me.chk1.TripleState = True
  ' ON・OFF・Null の3つの状態を持つようになる　まず使わないだろうが

End Sub

Private Sub btn4_Click() ' ON・OFF・Null の判定

  'btn3で、3状態にしておく

'  MsgBox Me.chk1.Value   Nullである場合があるので、こういうコードはNG

  If IsNull(Me.chk1.Value) Then
    MsgBox "Null"
  ElseIf Me.chk1.Value Then
    MsgBox "True"
  Else
    MsgBox "False"
  End If

End Sub
```
### トグルボタン
```
Private Sub Button1_Click()

    With Form1.ToggleButton1
        .Value = True    ' 押してある状態に設定
        .Value = False   ' 押していない状態に設定
    End With

End Sub

Private Sub Button1_Click()

    With Form1.ToggleButton1
        .Locked = True    ' ロック(操作できない)状態にする
        .Enabled = False   ' 無効にする
    End With

End Sub
```
### オプションボタン
```
※ユーザフォーム1.xlsm  OptFormフォーム

************   プロパティ  ********

Alignment = fmAlignmentLeft    Captionの文字列を左側に
Alignment = fmAlignmentRight   Captionの文字列を右側に

Value = True           チェックがある
Value = False          チェックが無い

※チェックボックスと同じように3状態を持つようにもできるが、まず使わないはず。詳しくはチェックボックスを

GroupName     同一のGroupNameをつけた複数のオプションボタンのうち、チェックが入るのは1つだけになる

フレーム内に配置した場合は、そのフレームと一緒にオプションボタンもグループ化される
ただし、GroupNameは空白になる。フレーム外に置く場合だけGroupNameを設定すればいい





Private Sub btn1_Click()  ' Captionの位置を左にする

  Me.opt1.Alignment = fmAlignmentLeft

End Sub

Private Sub btn2_Click()  ' チェックの有無を判定

  Me.opt2.Value = True
  Me.opt4.Value = True
  
  If opt2.Value Then
    MsgBox "opt2はチェックが入っている"
  Else
    MsgBox "opt2はチェックが入っていない"
  End If
  
  'オプションボタンは、フォームロード時に1つもチェックが入っていない場合があるので、
  'チェックの有無判定は注意
  '以下のような方法が手堅いか
  Select Case True
  Case Me.opt3.Value
    MsgBox "opt3にチェックが入っている"
  Case Me.opt4.Value
    MsgBox "opt4にチェックが入っている"
  Case Else
    MsgBox "opt3にもopt4にもにチェックは入っていない"
  End Select
  
End Sub
```
### リストボックス
```
※ユーザフォーム1.xlsm  ListFormフォーム

***********    プロパティ   **************

★ColumnCount
リスト ボックスに表示する列の数


★MultiSelect

fmMultiSelectSingle
項目は 1 つだけ選択できます (既定値)。

fmMultiSelectMult
複数選択を許可します。
項目の選択/選択解除を行うには、Space キーを押すか、またはクリックします。

fmMultiSelectExtended
複数選択を許可します。
Shift キーを押しながらクリックするか、または Shift キーを押しながら方向キーを押すと、現在選択されている項目を始点として一連の項目を連続的に選択できます。
項目の選択/選択解除を個別に行うには、Ctrl キーを押しながらクリックします。


'1列だけのリストの場合は、要素の追加はコンボボックスと同じで

Private Sub btn1_Click()  'リストの内容を設定

  '1列のリストボックス
  With Me.list1
    .ColumnCount = 1  '1列のリストにする
    .List = シート1.Range("A1:A10").Value  ' シートから取得
    'コンボボックスだと、シートがアクティブでないとエラーになるようだが、リストボックは大丈夫?
  End With
  
  '2列のリストボックス
  With Me.list2
    .ColumnCount = 2  '2列のリストにする
    .RowSource = シート1.Range("B1:C10").Address(External:=True)  ' シートから取得
    'コンボボックスだと、シートがアクティブでないとエラーになるようだが、リストボックは大丈夫?
  End With
  
End Sub


Private Sub btn2_Click()  'リストの内容を設定

  Dim var1 As Variant
  var1 = シート1.Range("B1:C10").Value
  
  With Me.list2
    .ColumnCount = 2
    .List = var1  'Variant変数の配列からリストへ
  End With

End Sub


Private Sub btn3_Click()  'リストの内容を設定

  Dim arr1(3, 2) As String
  arr1(0, 0) = "100"
  arr1(0, 1) = "AAA"
  arr1(1, 0) = "200"
  arr1(1, 1) = "BBB"
  arr1(2, 0) = "300"
  arr1(2, 1) = "CCC"
  
  With Me.list2
    .ColumnCount = 2
    .List = arr1  '2次元配列からリストへ
  End With

End Sub


Private Sub btn4_Click()  '複数列のリストにする

  With Me.list2
    .ColumnCount = 3
    .Width = 250
    .ColumnWidths = "30;120;100"  '各列の幅をポイント単位で指定する
    .ColumnHeads = True
    ' セル範囲の1つ上にある行を、見出しとして設定(セル範囲の1行目ではない)　RowSourceのみ
    .RowSource = シート1.Range("E2:G10").Address(External:=True)
  End With

End Sub


Private Sub btn5_Click()  '複数列のリストの値を取得

'btn4でリストの設定をして、何か選択してから

  With Me.list2
    Debug.Print .ListIndex  '選択されているインデックス番号 何も選択されていない場合は-1が返る
    
    If .ListIndex <> -1 Then
      Debug.Print .List(.ListIndex, 0)
      '選択されている行の1列目の値。このコードは何も選択されていないとエラー
      Debug.Print .List(.ListIndex, 1) '選択されている行の2列目の値
    End If
    
    .ListIndex = 4  '5行目を選択
  End With
  
End Sub


Private Sub btn6_Click()
'項目を選択している状態にする　項目が選択されているかどうかの判定

'btn4でリストの設定をしてから
  With Me.list2
    .MultiSelect = fmMultiSelectExtended  ' 複数選択可能、Ctrl・Shiftキーでの選択可能にする
    
    .Selected(0) = True  '1行目の要素を選択状態に
    .Selected(3) = True  '4行目の要素を選択状態に
    .Selected(6) = True
    
    Debug.Print .Selected(0)  '1行目の要素が選択されているか True
    Debug.Print .Selected(1)  ' False
    
  End With

End Sub


Private Sub btn7_Click()  '1列のリストで、選択されている値を取得

  'btn1でリストの設定をしてから

  With Me.list1
    Debug.Print .Text
    ' 選択されている文字列を取得。何も選択されていない場合は空文字
    Debug.Print VarType(.Text)
  End With
  
End Sub

Private Sub btn8_Click()

  Me.list1.Clear    '内容をクリアする .RowSourceで参照を設定しているリストはエラーになるので注意
  Me.list2.Clear

End Sub
```
### コンボボックス
```
※ユーザフォーム1.xlsm  CmbFormフォーム

*************    Styleプロパティの意味   **********************

fmStyleDropDownCombo
コンボ ボックス (ComboBox) コントロールは、選択項目のリストを持つコンボ ボックスとして機能します。
編集領域に値を入力したり、選択項目のリストから値を選択することができます。

fmStyleDropDownList
コンボ ボックス (ComboBox) コントロールは、リスト ボックスとして機能します。
リストから値を選択しなければなりません。


Private Sub btn1_Click()

  Dim arr1(3) As String
  arr1(0) = "AAA"
  arr1(1) = "bbb"
  arr1(2) = "CCC"

  With Me.cmb1
    .AddItem 100
    .AddItem 200
    .AddItem 300
    'リストの項目に、順番に要素を追加
  End With
  
  With Me.cmb2
    .List = arr1
  End With

  With Me.cmb3
    .List = シート1.Range(Cells(1, 1), Cells(10, 1)).Value
    ' シートのセル範囲からリストの設定ができる
    'この方法は、シート1がアクティブでないとエラーになる
  End With
  
  With Me.cmb4
    .AddItem 100, 0
    .AddItem 200, 0
    .AddItem 300, 0
    'インデックス指定で、リストの項目に要素を追加。インデックスは0から。この例では逆順に追加になる
  End With
  
  
End Sub


Private Sub btn2_Click()

  With Me.cmb1
    .RemoveItem 0   ' 1番目の項目をリストから削除
  End With
  
  With Me.cmb2
    .Clear          ' リストの全項目削除
  End With

End Sub


Private Sub btn3_Click()
  
  With Me.cmb1
    .RowSource = Worksheets("シート1").Range(Cells(1, 1), Cells(10, 1)).Address(External:=True)
    'シート1のA1:A10の値をリストの設定範囲とする。シート1がアクティブでないとエラーになるらしい
    'この方法を使っている場合、AddItemでの要素追加はエラーになる
    
'    .RowSource = シート1.Range(Cells(1, 1), Cells(10, 1)).Address
    '(External:=True)は、一応指定するべきか。上のコードでも大丈夫みたいだけど
    
    'このやり方はエラーが発生するパターンが多い。無理に使わないほうがいいか
  End With
  
End Sub


Private Sub btn4_Click()

  Debug.Print Me.cmb1.Text    '選択されている値を取得
  Debug.Print Me.cmb1.Value   '選択されている値を取得
  
  Debug.Print VarType(Me.cmb1.Text)    '8 文字列型
  Debug.Print VarType(Me.cmb1.Value)   '8 文字列型

  どちらも同じ結果になるが､Textが無難だろう

End Sub


Private Sub btn5_Click()
  
  With Me.cmb4
    If .Text <> "" Then
      .AddItem .Text   ' コンボボックスに入力したテキストを項目として追加
      'Styleプロパティが、リストから選択のみになっていると値が変更できないので意味無し
    End If
  End With
  
End Sub



Private Sub btn6_Click()

   With Me.cmb1
    If .MatchFound = True Then  ' テキストの値がリスト内にある場合
      MsgBox "リストにある値です"
    Else
      MsgBox "リストには無い値です"
    End If
  End With

  '※リストから選んだ値は必ず "リストにある値です" と判定されるが、
  '直接入力した場合は、判定が当てにならないようだ。特に数値が怪しい
  'リストボックスに入力すると自動補正されるようなので、この判定機能は信じないほうがいいかも
  
End Sub



Private Sub btn7_Click()

  With Me.cmb1
    MsgBox .ListIndex
    '選択されている要素のインデックス番号を取得。番号は0から。何も選択されていない場合は、-1が返る
    
    .ListIndex = 1  '2番目の要素を選択した状態にする
  End With

End Sub



Private Sub btn8_Click()

  Me.cmb1.Clear   ' 内容をクリア .RowSourceで参照しているものはエラーになるので注意
  Me.cmb2.Clear
  Me.cmb3.Clear
  Me.cmb4.Clear

End Sub
```
### ラベル　　縦書きや、ハイパーリンクを設定することも可能
```
Private Sub lbl_Click()

  ThisWorkbook.FollowHyperlink Address:="http://crossfish.sakura.ne.jp/same/TOP/top.html"
  ' ラベルにハイパーリンク付与

End Sub


Fontを「@」で始まるものにすると、90度左回転の文字列になる

テキストエディタで改行入りの文字列をCaptionに入力すれば、縦書きにできる
```
### Load Unload Show Hide　の関係
```
************   標準モジュール   *******************

Sub ccc()

  With Form2

    Load Form2 ' メモリ上にForm2をロード  この時点で、フォームのInitializeイベント発動
    
    .txt1.Text = "Loadした"  'テキストボックスのテキストを設定
  
    .Show vbModeless
    'form2を表示　Loadされていない場合は、自動でLoadされるらしい　Excelの操作できるようにモードレス表示
    
    .Hide  'form2を非表示に。メモリ上には残る
    
    .txt1.Text = "あいう"
    
    .Show vbModeless
    
    Unload Form2  'メモリ上からアンロード
    
'    .Show vbModeless  これはエラーになってしまう。よくわからないが
    
  End With

End Sub


Sub ddd()

  Form2.Show vbModeless
  ' これでもフォームは表示される。フォームのInitializeイベントも発動する
  
  '事前にコントロールの値を設定する等をしないなら、Loadは無しでShowでいいかも
  
End Sub



************  Form2    ******************************

Private Sub UserForm_Initialize()

  MsgBox "Form2が初期化された"

End Sub
```
### Formを×ボタンで閉じられないようにする
```
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then  ' ×ボタンで閉じようとした場合
        MsgBox "×ボタンで閉じることはできません"
        Cancel = True   ' 閉じる動作をキャンセルする
    End If
End Sub
```
### 標準モジュールとユーザーフォーム間で、値の受け渡しをするいくつかの方法
```
********************   グローバル変数を使う   ***************

*************  標準モジュール

Option Explicit

Public globalLong1 As Long  'プロジェクト内全体のグローバル変数

Sub aaa()

  globalLong1 = 123
  Form2.Show  'フォームを表示

End Sub


*************  フォーム

Private Sub btn1_Click()

  Me.txt1.Text = globalLong1   'グローバル変数から値を取得
  
End Sub





********************   引数で渡す   ***************

*************  標準モジュール

Sub bbb()

  Call Form2.ShowForm2(547)
  'Form2を表示するプロシージャを呼び出し  Call ShowForm2(547) はエラーなので注意

End Sub


*************  フォーム

Option Explicit

Private formLong1 As Long   ' フォームのコード内でのグローバル変数

Public Sub ShowForm2(ByVal long1 As Long)
'フォームのコード内でも、普通のプロシージャは使える

  formLong1 = long1
  Me.txt1.Text = formLong1
  Me.Show

End Sub



********************   戻り値で受け取る   ***************

*************  標準モジュール

Sub eee()
  
  Load Form2
  MsgBox Form2.ReturnText
  Unload Form2

End Sub


*************  フォーム

Public Function ReturnText() As String

  Me.txt1.Text = "KKK"
  ReturnText = Me.txt1.Text

End Function
```
### ユーザーフォームにコントロールを新規追加する
```
※ユーザフォーム1.xlsm  Form2フォーム

Private Sub btn1_Click()   'ラベルの新規追加

  Dim newLabel As MSForms.Label          'ラベル
  Dim newText As MSForms.TextBox         'テキストボックス
  Dim newCheck As MSForms.CheckBox       'チェックボックス
  Dim newCombo As MSForms.ComboBox       'コンボボックス
  Dim newButton As MSForms.CommandButton 'コマンドボタン
  ' MSForms. まで入力すれば候補が出るので、他のコントロールも分かるはず
  
  
    Set newLabel = Me.Controls.Add("Forms.Label.1", "lbl1")
    '名前をつけてラベルを追加 "lbl1"が名前になる 名前を指定しない場合は、Excelが自動で付ける
    ' Label.1 というのはラベルの場合の固定らしい Label.2 とかは無い
    
    With newLabel
      .Caption = "ラベル1"
      .AutoSize = True 'サイズは自動
      .Left = 20 '左からの距離
      .Top = 20 '上からの距離
    End With
    
    Set newLabel = Me.Controls.Add("Forms.Label.1")
    With newLabel
      .Name = "lbl2"  'ここで名前を設定してもいい。リンク先の情報では、当時はできなかった?
      .Caption = "ラベル2"
      .AutoSize = True
      .Left = 100
      .Top = 20
    End With
    
    
    MsgBox Me("lbl1").Caption
    MsgBox Me("lbl2").Caption
    '新規で追加したコントロールを指定するのは、Me(コントロール名) の形でないと駄目らしい
    
'    MsgBox Me.lbl1.Caption   このコードはエラーになる

End Sub


Private Sub btn2_Click()  'テキストボックス追加

  Dim newText As MSForms.TextBox
  
  Set newText = Me.Controls.Add("Forms.textbox.1")  'テキストボックス追加
  With newText
    .Name = "txt1"
    .Width = 80
    .Height = 18
    .Left = 20
    .Top = 40
  End With
  
  'このコードを複数回実行しても、エラーにはならないようだ。txt1が複数存在する状態になるらしい
  'トラブルの元なので、コントロール名の重複は無いように注意

End Sub



Private Sub btn3_Click() 'フォーム内の全コントロール名を出力

  Dim obj1 As Control
  
  For Each obj1 In Me.Controls
    Debug.Print obj1.Name
  Next obj1

End Sub

Private Sub btn4_Click() 'コンボボックスを10個追加

  Dim newCombo As MSForms.ComboBox
  Dim i As Long
  
  For i = 1 To 10
    Set newCombo = Me.Controls.Add("Forms.ComboBox.1")  'コンボボックス追加
    With newCombo
      .Name = "cmb" & i
      .Width = 80
      .Height = 20
      .Left = 20
      .Top = 20 + (i * 30)
      .Text = "コンボボックス" & i
    End With
  Next i

End Sub
```
### セル範囲の1行目だけをコンボボックス1に格納し、コンボボックス1の選択に合わせて、2行目以降の内容をコンボボックス2に格納する
```
Option Explicit

Private var1 As Variant  'セル範囲を格納するバリアント変数

Private Sub UserForm_Initialize()
'初期化時に、セル範囲の1行目だけをcmb1にセット

  Dim i As Long
  
  var1 = シート1.Range("I1").CurrentRegion
  
  For i = 1 To UBound(var1, 2)
  ' var1配列の2次元目の要素数までループ(列数になる)。var1のインデックスは1から始まる
  
    Me.cmb1.AddItem var1(1, i)  ' var1の1行目の要素だけ追加
  Next i

End Sub



Private Sub cmb1_Change()  'cmb1の選択が変更された時

  Dim i As Long
  
  Me.cmb2.Clear  ' cmb2の内容をクリア これが無いと要素が際限なく追加される
  
  For i = 2 To UBound(var1, 1)  ' var1配列の1次元目の要素数までループ(行数になる)
    If var1(i, Me.cmb1.ListIndex + 1) <> "" Then
    'cmb1で選択されている列の値が空白でない場合は、cmb2に要素を追加
      cmb2.AddItem var1(i, Me.cmb1.ListIndex + 1)
    End If
  Next i
  
End Sub
```
### テキストボックスの入力値チェックの例
```
※ユーザフォーム1.xlsm  ValidationFormフォーム


Private Sub txt1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'このコントロールから離れようとした時のイベント

  With Me.txt1
    If .Text = "" Then
      Exit Sub  'これを用意しないと、空白でも抜けられなくなるので
    End If
    
    If Not IsNumeric(.Text) Then  '数値のみ受け入れ。全角の数値でも受け取るが
'      MsgBox "数値のみです"   これでもいいが、フォームを閉じる時にも出てしまう
      Me.lblErrorMessage.Caption = "数値のみです"
      .BackColor = RGB(255, 204, 255)  ' 背景をピンクに
      Cancel = True  'このコントロールへ戻る
    Else
      .BackColor = RGB(255, 255, 255)
    End If
  
  End With

End Sub



Private Sub txt2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  Dim reg As Variant
  Set reg = CreateObject("VBScript.RegExp")
  
  With reg
    .Global = True          ' 文字列全体を検索
    .IgnoreCase = False     ' 大文字小文字を区別する
    .Pattern = "^[A-Za-z0-9]*[A-Za-z0-9]$"
  End With

  With Me.txt2
    If .Text = "" Then
      Exit Sub
    End If
    
    If reg.Test(.Text) = False Then
      Me.lblErrorMessage.Caption = "半角英数字のみです"
      .BackColor = RGB(255, 204, 255)
      Cancel = True
    Else
      .BackColor = RGB(255, 255, 255)
    End If
  
  End With
  
  Set reg = Nothing
  
End Sub



Private Sub txt3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  Dim reg As Variant
  Set reg = CreateObject("VBScript.RegExp")
  
  With reg
    .Global = True          ' 文字列全体を検索
    .IgnoreCase = False     ' 大文字小文字を区別する
    .Pattern = "^[ァ-ヴｦ-ﾟ]*[ァ-ヴｦ-ﾟ]$"
    'これでカタカナ全般。カタカナの正規表現はネットで検索して
    'ちなみに、Excel自体の文字コードはUnicodeらしい
  End With

  With Me.txt3
    If .Text = "" Then
      Exit Sub
    End If
    
    If reg.Test(.Text) = False Then
      Me.lblErrorMessage.Caption = "カタカナのみです"
      .BackColor = RGB(255, 204, 255)
      Cancel = True
    Else
      .BackColor = RGB(255, 255, 255)
    End If
  
  End With
  
  Set reg = Nothing
  
End Sub
```
### テキストボックスのイベント一覧
```
AfterUpdate
コントロールのデータがユーザー インターフェイスを介して変更された後に発生します。

BeforeDragOver
ドラッグ アンド ドロップ操作の実行中に発生します。

BeforeDropOrPaste
ユーザーがオブジェクトにデータをドロップするか貼り付けようとすると発生します。

BeforeUpdate
コントロールのデータが変更される前に発生します。

Change
Value プロパティが変更されたときに発生します。

DblClick
ユーザーがオブジェクトをポイントし、マウス ボタンを 2 回クリックすると発生します。

DropButtonClick
ドロップダウン リストが表示または非表示になると常に発生します。テキストボックスがアクティブな状態でF4押下で発生。

Enter
コントロールが、同じフォームの他のコントロールから実際にフォーカスを受け取る前に発生します。

Error
コントロールがエラーを検出し、エラー情報を呼び出し元プログラムに返すことができないときに発生します。

Exit
コントロールがフォーカスを失い、そのフォーカスが同じフォームにある他のコントロールに移動する直前に発生します。
KeyDown
ユーザーがキーを押すと発生します。

KeyPress
ユーザーが ANSI キーを押すと発生します。

KeyUp
ユーザーがキーを離すと発生します。

MouseDown
ユーザーがマウス ボタンを押したときに発生します。

MouseMove
ユーザーがマウスを動かしたときに発生します。

MouseUp
ユーザーがマウス ボタンを離したときに発生します。
```
### ユーザーフォームのイベント一覧
```
Activate
Activate イベントは、オブジェクトがアクティブなウィンドウになったときに発生します。Deactivate イベントは、オブジェクトがアクティブなウィンドウではなくなったときに発生します。

AddControl
フォーム、 Frame 、または MultiPage の Page にコントロールが追加されたときに発生します。

BeforeDragOver
ドラッグ アンド ドロップ操作の実行中に発生します。

BeforeDropOrPaste
ユーザーがオブジェクトにデータをドロップするか貼り付けようとすると発生します。

Click
クリックされたときに発生します。

DblClick
マウス ポインターをオブジェクトの上に置き、システムで設定されているダブルクリックの間隔内に、マウスの左ボタンを押してから離す動作を 2 回続けて行ったときに発生します。

Deactivate
フォームがフォーカスを失い、アクティブでなくなると発生します。

Error
フォームやレポートにフォーカスがあるときに、Excelで実行時エラーが検出されたときに発生します。

Initialize
UserForm が読み込まれた後で表示される前に発生します。

KeyDown
ユーザーがキーを押すと発生します。

KeyPress
ユーザーが ANSI キーを押すと発生します。

KeyUp
ユーザーがキーを離すと発生します。

Layout
子コントロールの位置を変更する必要があるときに発生します。

MouseDown
ユーザーがマウス ボタンを押したときに発生します。

MouseMove
ユーザーがマウスを動かしたときに発生します。

MouseUp
ユーザーがマウス ボタンを離したときに発生します。

QueryClose
UserForm が閉じる前に発生します。

RemoveControl
コントロールが コンテナーから削除されたときに発生します。

Resize
フォームを開いたとき、およびフォームのサイズが変更されるたびに、 Resizeイベントが発生します。

Scroll
マウスまたはキーボードの操作でスクロール ボックスが移動したときに発生します。

Terminate
オブジェクトを参照するすべての 変数が Nothing に設定されて、オブジェクトのインスタンスへの参照がメモリからすべて削除されるか、オブジェクトへの最後の参照が スコープ外になったときに発生します。

Zoom
Zoom プロパティの値が変更されたときに発生します。


Private Sub btnClose_Click()
  Unload Me
End Sub


Private Sub UserForm_Initialize()
  MsgBox "Initializeイベント発生"
End Sub


Private Sub UserForm_Activate()
  MsgBox "Activateイベント発生"
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

  If CloseMode = 0 Then  ' ×ボタンで閉じようとした場合
    MsgBox "×ボタンで閉じることはできません"
    Cancel = True   ' 閉じる動作をキャンセルする
  End If
  
  MsgBox "QueryCloseイベント発生"

End Sub


Private Sub UserForm_Terminate()
  MsgBox "Terminateイベント発生"
End Sub
```
### コントロールの種類を確認する　　TypeName
```
Dim ctl As Control
  
  For Each ctl In PartsForm.Controls
    Debug.Print TypeName(ctl)  'コントロールの種類を出力
    Debug.Print ctl.Name
    Debug.Print "---------------------------"
  Next ctl
  
  
  If TypeName(PartsForm.btn1) = "CommandButton" Then
    MsgBox "コマンドボタンです"
  Else
    MsgBox "コマンドボタン以外です"
  End If
  
'  CommandButton  コマンドボタン
'  Label          ラベル
'  TextBox        テキストボックス
'  ComboBox       コンボボックス
'  ListBox        リストボックス
'  CheckBox       チェックボックス
'  OptionButton   オプションボタン
'  ToggleButton   トグルボタン
'  TabStrip       タブストリップ
'  RefEdit        RefEdit
'  MultiPage      マルチページ
'  SpinButton     スピンボタン
'  ScrollBar      スクロールバー
'  Image          画像
```
### コントロールの状態を動的に変化させる例。表示/非表示を切り替える
```
※ユーザフォーム1.xlsm ControlsChangeフォーム


Private Sub UserForm_Initialize() '初期処理

  With Me.cmb1
    .Style = fmStyleDropDownList
    .List = Array(0, 1, 2, 3, 4, 5)
  End With
  
  Call ControlsUnVisibleAll  '最初はチェックボックスとテキストボックスは全て非表示
  
End Sub


Private Sub cmb1_Change()  'コンボボックスで数値を選択

  Dim i As Long
  For i = 1 To Me.cmb1.Value
    Me.Controls("chk" & i).Visible = True
  Next
  Call ControlsUnVisible(Me.cmb1.Value)
  
End Sub


'チェックボックスのチェックを変更
Private Sub chk1_Change()
  Me.txt1.Visible = Me.chk1.Value
End Sub

Private Sub chk2_Change()
  Me.txt2.Visible = Me.chk2.Value
End Sub

Private Sub chk3_Change()
  Me.txt3.Visible = Me.chk3.Value
End Sub

Private Sub chk4_Change()
  Me.txt4.Visible = Me.chk4.Value
End Sub

Private Sub chk5_Change()
  Me.txt5.Visible = Me.chk5.Value
End Sub



'指定数値以降のチェックボックスとテキストボックスを非表示
Private Sub ControlsUnVisible(Optional ByVal cnt As Long = 0)
  Dim i As Long
  For i = cnt + 1 To 5
    Me.Controls("chk" & i).Visible = False
    Me.Controls("chk" & i).Value = False
    Me.Controls("txt" & i).Visible = False
  Next
End Sub


'全てのチェックボックスとテキストボックスを非表示
Private Sub ControlsUnVisibleAll()

  Dim ctl As Control
  For Each ctl In Me.Controls
    Select Case TypeName(ctl)  'コントロールの種類を取得
      Case "CheckBox", "TextBox"
        ctl.Visible = False
    End Select
  Next
End Sub
```
### クラスを利用して、コントロールの表示/非表示、追加/削除を動的に実行する
```
※ユーザフォーム1.xlsm 　AddDeleteControlsフォーム   AddDeleteControlsClassクラス



****************   AddDeleteControlsClass　クラス  ************************************

Option Explicit

Private WithEvents pCheckBox As MSForms.CheckBox
'イベントを発生させるチェックボックスのオブジェクト

Private pForm As MSForms.UserForm
'コントロールの親であるフォーム


'対応するコントロールを設定するプロパティ
Public Property Set CheckBox(ByVal aCheckBox As MSForms.CheckBox)

  Set pCheckBox = aCheckBox
  Set pForm = aCheckBox.Parent  'コントロールの親であるフォームにSet
  
End Property



Private Sub pCheckBox_Change()
'WithEventsのイベントプロシージャー。チェックボックスの値が変化した時に発動
'プロシージャ名は、「イベント変数名_イベント名」にする

  Dim strNum As String
  strNum = Right(pCheckBox.Name, 2)  '下2桁はコントロールの番号になる
  
  Dim txt As MSForms.TextBox
  
  Set txt = GetTextBox(strNum) 'テキストボックスの存在確認。存在しなかった場合はNothingが返る
  If txt Is Nothing Then
  'Nothingの場合は、そのコントロールが存在しなかったことになるので、新規作成
  
    Set txt = pForm.Add("Forms.TextBox.1", "txt" & strNum)
    'テキストボックスを新規に追加　"txt" & strNumがコントロール名になる
    With txt
      .Top = strNum * 30 + 15
      .Left = 35
      .Height = 25
      .Width = 168
    End With
  End If
  
  txt.Visible = pCheckBox.Value
  'チェックボックスのチェックが入っている場合は、右にあるテキストボックスを表示
  'チェックボックスのチェックが入っていない場合は、右にあるテキストボックスを非表示に
  
End Sub


'テキストボックスの存在確認。エラー発生を使った簡易コード
Private Function GetTextBox(ByVal strNum As String) As MSForms.TextBox

  On Error Resume Next
  Set GetTextBox = pForm.Controls("txt" & strNum)
  'コントロールの親であるフォームのテキストボックスとしてSet
  '存在しないコントロール名を指定した場合は、エラーが発生する。その時はNothingをリターン
  
End Function




*********************   AddDeleteControlsフォーム     **************************

Option Explicit

'コンボボックスcmb1で指定した数値の数だけ、チェックボックスを用意する
'現在存在するチェックボックスの数がcmb1で指定した数値よりも多い場合は、それに合わせて削除する
'チェックボックスのチェックを入れると、その右にテキストボックスが存在しない場合は新規に追加、
'存在する場合は再表示
'チェックボックスのチェックを外すと、その右のテキストボックスは非表示に

Private clsADC() As AddDeleteControlsClass  'イベントを起こすクラスを要素とする配列


Private Sub UserForm_Initialize()  '初期処理

  With Me.cmb1
    .List = Array(0, 1, 2, 3, 4, 5)  'cmb1に0-5の要素をセット
  End With
  
  ReDim clsADC(1 To 5)
  
End Sub



Private Sub cmb1_Change()  'cmb1の値が変化した時

  Dim ctl As Control
  Dim max As Long
  Dim num As Long
  
  max = Me.cmb1.Value  'cmb1の選択されている数値を、フォーム上のコントロールの最大数とする
  
  For Each ctl In Me.Controls  '現時点で存在するコントロールを走査
  
    If IsNumeric(Right(ctl.Name, 2)) Then
    'コントロール名の末尾2文字が数値の場合は、チェックボックスかテキストボックス
      num = Right(ctl.Name, 2)
      If num > max Then  'cmb1で指定している数値を超える番号の場合
        Me.Controls.Remove ctl.Name  'コントロールの削除
      End If
    End If
  Next
  
  For num = 1 To max
    Call AddCheckBox(num)  'チェックボックスの動的追加処理を呼び出し
  Next
  
End Sub



'チェックボックスの動的追加
Private Function AddCheckBox(ByVal num As Long) As MSForms.CheckBox
  
  Set AddCheckBox = GetCheckBox(num)  'チェックボックスの存在確認
  If Not AddCheckBox Is Nothing Then Exit Function
  '既に存在しているコントロール名の場合は、処理終了
  'Nothingが返って来ている場合は、チェックボックスを追加する
  
  'チェックボックスをフォームに追加
  Dim strName As String
  strName = "chk" & Format(num, "00")
  Set AddCheckBox = Me.Controls.Add("Forms.CheckBox.1", strName)
  ' strNameをコントロール名として、チェックボックスを新規追加
  With AddCheckBox
    .Top = num * 30 + 15
    .Left = 10
    .Height = 18
    .Width = 20
    .Caption = ""
  End With
  
  '追加したチェックボックスをクラスに設定
  Set clsADC(num) = New AddDeleteControlsClass
  Set clsADC(num).CheckBox = AddCheckBox
End Function


'チェックボックスの存在確認。エラー発生を使った簡易コード
Private Function GetCheckBox(ByVal num As Long) As MSForms.CheckBox

  On Error Resume Next
  Set GetCheckBox = Me.Controls("chk" & Format(num, "00"))
  'コントロールの親であるフォームのチェックボックスとしてSet
  '存在しないコントロール名を指定した場合は、エラーが発生する。その時はNothingをリターン
  
End Function
```
### クラスを利用して、コントロールのイベントを全て管理する例
```
Enter・Exit・BeforeDropOrPaste・BeforeUpdateの4イベントは除く

※ユーザフォーム1.xlsm  ControlEvent1フォーム   ControlEventClass1クラス



****************  ControlEvent1フォーム   ************************************

Option Explicit

'ControlEventClass1に登録してあるイベントで、コンボボックスは多数のイベントが
'発生する度に、ラベルの内容が変化する
'コンボボックスの値を変更してみると分かる


Private colEvent As New Collection  'ControlEventClass1クラスのコレクション

Private Sub UserForm_Initialize()

  'ControlEventClass1クラスを作成しコレクションに追加
  Dim clsEvent As ControlEventClass1
  Dim ctl As MSForms.Control
  
  For Each ctl In Me.Controls
    Select Case TypeName(ctl)
      Case "TextBox", _
         "CheckBox", _
         "OptionButton", _
         "ComboBox", _
         "ListBox", _
         "CommandButton"
        Set clsEvent = New ControlEventClass1
        Set clsEvent.Control = ctl
        colEvent.Add clsEvent
      Case Else
        '※他のコントロールも、必要に応じて追加で
    End Select
  Next
  
  'コンボボックスのリストを設定
  Dim i As Long
  For i = 1 To 5
    Me.cmb01.AddItem i
  Next i
  
End Sub





*********************   ControlEventClass1クラス   **************************

Option Explicit

Private pForm As MSForms.UserForm  'コントロールの親であるフォーム

Private pControl As MSForms.Control  '対象となるコントロールオブジェクト。必要ないかも

Private WithEvents pCheckBox As MSForms.CheckBox
'イベントを発生させるチェックボックスオブジェクト
Private WithEvents pTextBox As MSForms.TextBox              'テキストボックスオブジェクト
Private WithEvents pComboBox As MSForms.ComboBox            'コンボボックスオブジェクト
Private WithEvents pOptionButton As MSForms.OptionButton    'オプションボタンオブジェクト
Private WithEvents pListBox As MSForms.ListBox              'リストボックスオブジェクト
Private WithEvents pCommandButton As MSForms.CommandButton  'コマンドボタンボタンオブジェクト
'※他のコントロールも、必要に応じて追加で


Public Property Get Control() As MSForms.Control  'pControl取得用
  Set Control = pControl
End Property

Public Property Set Control(ByVal aControl As MSForms.Control)
  Set pControl = aControl 'Get用にControlで別途格納
  Set pForm = aControl.Parent 'コントロールの親フォーム
  
  Select Case TypeName(aControl)  'コントロールの種類に応じて、各コントロールオブジェクトにセット
    Case "TextBox"
      Set pTextBox = aControl
    Case "CheckBox"
      Set pCheckBox = aControl
    Case "OptionButton"
      Set pOptionButton = aControl
    Case "ComboBox"
      Set pComboBox = aControl
    Case "ListBox"
      Set pListBox = aControl
    Case "CommandButton"
      Set pCommandButton = aControl
    Case Else
      '※他のコントロールのプロパティも、必要に応じて追加で
  End Select
End Property



'チェックボックスの値が変化した場合のイベントプロシージャ
Private Sub pCheckBox_Change()
'プロシージャ名は、「イベント変数名_イベント名」にする
   pForm.Controls("lbl01").Caption = pCheckBox.Name & "の値が変更された"
End Sub

'テキストボックスの値が変化した場合のイベントプロシージャ
Private Sub pTextBox_Change()
  pForm.Controls("lbl01").Caption = pTextBox.Name & "の値が変更された"
End Sub


'**************  コンボボックスのみ、全てのイベントを並べてみる   ***********************

Private Sub pComboBox_BeforeDragOver( _
  ByVal Cancel As MSForms.ReturnBoolean, _
  ByVal Data As MSForms.DataObject, _
  ByVal X As Single, _
  ByVal Y As Single, _
  ByVal DragState As MSForms.fmDragState, _
  ByVal Effect As MSForms.ReturnEffect, _
  ByVal Shift As Integer)
  
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のBeforeDragOverイベント発動"
End Sub

Private Sub pComboBox_Change()
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のChangeイベント発動"
End Sub

Private Sub pComboBox_Click()
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のClickイベント発動"
End Sub

Private Sub pComboBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のDblClickイベント発動"
End Sub

Private Sub pComboBox_DropButtonClick()
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のDropButtonClickイベント発動"
End Sub

Private Sub pComboBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のKeyDownイベント発動"
End Sub

Private Sub pComboBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のKeyPressイベント発動"
End Sub

Private Sub pComboBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のKeyUpイベント発動"
End Sub

Private Sub pComboBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のMouseDownイベント発動"
End Sub

Private Sub pComboBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のMouseMoveイベント発動"
End Sub

Private Sub pComboBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  pForm.Controls("lbl01").Caption = pComboBox.Name & "のMouseUpイベント発動"
End Sub


'以下は使用不可・APIを使うと可能らしい
Private Sub pComboBox_AfterUpdate()
End Sub

Private Sub pComboBox_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
  ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, _
  ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, _
  ByVal Shift As Integer)
End Sub

Private Sub pComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub

Private Sub pComboBox_Enter()
End Sub

Private Sub pComboBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
```
### コントロールのTagプロパティ　　ユーザーフォーム、コントロールのそれぞれに用意された、自由に使えるグローバル変数領域。コントロール・フォーム・標準モジュールの間で値を参照・設定できる
```
ユーザーフォーム1.xlsm  TagFormフォーム　Module1


********  標準モジュール   **********************

Private Sub ShowTagForm() 'TagFormを初期化、表示

  Load TagForm
  
  With TagForm
    .Tag = "TagFormのTAG"  'TagFormのTagプロパティに値を設定
    'Tagプロパティは、自由に使えるグローバル変数領域らしい。配列は駄目。多分オブジェクトも
    .btn1.Tag = "BTN1"
    .txt1.Tag = 1000
  End With
  
  TagForm.Show

End Sub




****************    TagForm    ******************

Private Sub btn1_Click()

  Me.lbl1.Caption = Me.btn1.Tag
  'btn1のTagの値をlbl1に表示
  
End Sub


Private Sub txt1_Change()
  
  Me.lbl1.Caption = Me.Tag  'TagFormのTagの内容を取得
  
End Sub
```
### WindowsのAPIを利用して、クラスでコントロールのイベントを一括管理する例
```
Enter・Exitイベントも管理できる　　仕組みはよく分からないが、利用価値は高いだろう

ユーザーフォーム1.xlsm  ControlEventフォーム  CotrolEventClassクラス     ControlEventClass2.cls


********  ControlEventClass2.cls   **********************
※この内容のclsファイルをインポートしてクラスを作成している
インポートでないと駄目なのかどうかは不明
cls ファイルは、SJISでないと文字化けするかも


VERSION 1.0 CLASS

BEGIN
  MultiUse = -1  'True
END

Attribute VB_Name = "ControlEventClass2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit

'API定義 [ ConnectToConnectionPoint ]
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
    (ByVal pUnk As stdole.IUnknown, ByRef riidEvent As GUID, _
    ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, _
    ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
    
Private Cookie As Long
Private MyCtrl As Object 'イベント接続するコントロール

'イベント接続
Public Property Set Control(NewCtrl As Object)
  Set MyCtrl = NewCtrl
  Call ConnectEvent(True)
End Property

'イベント切断
Public Sub Clear()
  If (Cookie <> 0) Then
    Call ConnectEvent(False)
  End If
  Set MyCtrl = Nothing
End Sub

'イベント接続切断
Private Sub ConnectEvent(ByVal Connect As Boolean)
  Dim IID_IDispatch As GUID
  With IID_IDispatch
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
  End With
  ConnectToConnectionPoint Me, IID_IDispatch, Connect, MyCtrl, Cookie, 0&
End Sub

'Enterイベントで背景色設定
Public Sub Event_Enter()
  Attribute Event_Enter.VB_UserMemId = -2147384830
  If TypeName(MyCtrl) = "Frame" Then Exit Sub
  MyCtrl.Tag = MyCtrl.BackColor
  MyCtrl.BackColor = RGB(255, 153, 204)
End Sub

'Exitイベントで背景色戻し
Public Sub Event_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  Attribute Event_Exit.VB_UserMemId = -2147384829
  Dim ctl As Control
  If TypeName(MyCtrl) = "Frame" Then
    For Each ctl In MyCtrl.Controls
      If ctl.Tag <> "" Then ctl.BackColor = ctl.Tag
    Next
  Else
    MyCtrl.BackColor = MyCtrl.Tag
  End If
End Sub




****************    CotrolEventClassクラス   ******************
※ControlEventClass2.clsをインポートしてできた内容が以下

Option Explicit

'API定義 [ ConnectToConnectionPoint ]
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
    (ByVal pUnk As stdole.IUnknown, ByRef riidEvent As GUID, _
    ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, _
    ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
    
Private Cookie As Long
Private MyCtrl As Object 'イベント接続するコントロール


'イベント接続
Public Property Set Control(NewCtrl As Object)

  Set MyCtrl = NewCtrl
  Call ConnectEvent(True)
  
End Property


'イベント切断
Public Sub Clear()

  If (Cookie <> 0) Then
    Call ConnectEvent(False)
  End If
  Set MyCtrl = Nothing
  
End Sub


'イベント接続切断
Private Sub ConnectEvent(ByVal Connect As Boolean)

  Dim IID_IDispatch As GUID
  With IID_IDispatch
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
  End With
  ConnectToConnectionPoint Me, IID_IDispatch, Connect, MyCtrl, Cookie, 0&
  
End Sub


'Enterイベントで背景色設定
Public Sub Event_Enter()

  If TypeName(MyCtrl) = "Frame" Then Exit Sub
  MyCtrl.Tag = MyCtrl.BackColor
  'コントロールのTagプロパティに、元の背景色を保存している
  MyCtrl.BackColor = RGB(255, 153, 204)
  
End Sub


'Exitイベントで背景色戻し
Public Sub Event_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  Dim ctl As Control
  If TypeName(MyCtrl) = "Frame" Then
    For Each ctl In MyCtrl.Controls
      If ctl.Tag <> "" Then ctl.BackColor = ctl.Tag
    Next
  Else
    MyCtrl.BackColor = MyCtrl.Tag
  End If
  
End Sub





***************  ControlEventフォーム   ***************************

Option Explicit

'ControlEventClass2クラスで、EnterイベントとExitイベントの一括管理をしている
'Enterイベント発生時にコントロールの背景色をピンクに変更
'Exitイベント発生時にコントロールの背景色を元に戻す
'適当に各種のコントロールを配置して、動作を確認してみればいい
'フレームの場合は、少し処理が特殊



Private colEvent As New Collection
'ControlEventClass2クラスのコレクション


Private Sub UserForm_Initialize()  '初期化時の処理

  Dim clsEvent As ControlEventClass2
  'APIでイベント管理するクラスのインスタンス
  
  Dim ctl As Control
  For Each ctl In Me.Controls
    Set clsEvent = New ControlEventClass2
    Set clsEvent.Control = ctl
    colEvent.Add clsEvent
  Next
End Sub


Private Sub UserForm_Terminate()  'フォームインスタンス廃棄時

  Dim clsEvent As ControlEventClass2
  
  For Each clsEvent In colEvent
  'ControlEventClass2インスタンスのコレクションの内容を、1つずつクリア
    clsEvent.Clear
  Next
  
  Set colEvent = Nothing
  
End Sub
```
### インクリメンタルサーチの例　　テキストボックスの入力内容に応じて、リストボックスの内容を変化させる
```
ユーザーフォーム1.xlsm　IncrimentalSearchフォーム



Option Explicit

Private isStopEvent As Boolean             'イベントを停止するか
Private activeTextBox As Control           'リスト対象のTextBox
Private Const BASE_HEIGHT As Double = 12   'ListBoxの1行の高さ フォントサイズに合わせて適当に



Private Sub UserForm_Initialize() 'フォーム初期処理

  'リストボックスのスタイル等の設定
  With Me.list1
    .Visible = False
    .ListStyle = fmListStylePlain
    .BorderStyle = fmBorderStyleSingle
    .Font.Size = 11
    .TabStop = False
  End With
  
  isStopEvent = False
  
End Sub


'**********   txt1のイベント  ****************
Private Sub txt1_Change()
  Call TextBoxChange(Me.txt1)
End Sub

Private Sub txt1_Enter()
  Call TextBoxChange(Me.txt1)
End Sub

Private Sub txt1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Call TextBoxKeyDown(Me.txt1, KeyCode, Shift)
End Sub


'**********   txt2のイベント  ****************
Private Sub txt2_Change()
  Call TextBoxChange(Me.txt2)
End Sub

Private Sub txt2_Enter()
  Call TextBoxChange(Me.txt2)
End Sub

Private Sub txt2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Call TextBoxKeyDown(Me.txt2, KeyCode, Shift)
End Sub



'リストボックスのEnter、またはTabでのフォーカスで、TextBoxにTextを入れる
Private Sub list1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

  Select Case KeyCode
    Case vbKeyReturn, vbKeyTab
      'Enterキー、Tabキーでリスト選択を決定
'      isStopEvent = True
      activeTextBox.Text = Me.list1.Text
      Me.list1.Visible = False
      activeTextBox.SetFocus
      KeyCode = 0
      isStopEvent = False
      
    Case vbKeyEscape
      'Escキーの場合は、リストを非表示に
'      isStopEvent = True
      Me.list1.Visible = False
      activeTextBox.SetFocus
      isStopEvent = False
  End Select
  
End Sub


'TextBoxのChangeイベント共通処理
Private Sub TextBoxChange(ByVal ctl As Control)

  Set activeTextBox = ctl
  If isStopEvent Then Exit Sub
  
  '未入力時は無視
  If ctl.Text = "" Then
    Me.list1.Visible = False
    Exit Sub
  End If
  
  'リストに表示する配列を作成
  Dim arr1
  arr1 = getListArray(ctl)
  
  '候補がない場合はリストボックスは表示しない
  If UBound(arr1) - LBound(arr1) < 0 Then
    Me.list1.Visible = False
    Exit Sub
  End If
  
  '候補が1つで完全一致の場合はリストを表示しない
  If UBound(arr1) - LBound(arr1) = 0 Then
    If ctl.Text = arr1(LBound(arr1)) Then
      Me.list1.Visible = False
      Exit Sub
    End If
  End If
  
  With Me.list1
    .List = arr1
  
    'テキストボックスのすぐ下に同じ幅で表示
    .Top = ctl.Top + ctl.Height
    .Left = ctl.Left
    .Width = ctl.Width
    .Height = BASE_HEIGHT * .ListCount
    'フォーム内に収める
    If .Top + .Height > Me.InsideHeight Then
      .Height = Me.InsideHeight - .Top
    End If
  
    .Visible = True
  End With
End Sub


'TextBoxのKeyDownイベント共通処理
Private Sub TextBoxKeyDown(ByVal ctl As Control, _
  ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  
  Select Case KeyCode
    Case vbKeyReturn, vbKeyTab
      Me.list1.Visible = False
      'リターンキー、タブキーの場合はリストを非表示に
      
    Case vbKeyDown
      '↓キーの時にリストにフォーカスを移す
      If Me.list1.Visible = True Then
        On Error Resume Next '想定外を考慮
        Me.list1.SetFocus
        On Error GoTo 0
        Me.list1.ListIndex = 0  '1行目を選択
      End If
  End Select
  
End Sub



'インクリメンタルサーチ
Private Function getListArray(ByVal ctl As Control) As Variant
  Dim var1 As Variant
  
  var1 = getListArrayByTextBox(ctl)  'テキストボックスによってリストの内容を変更
  
  '半角スペース・全角スペース1文字だけの場合は、スペースを消して全リストを表示
  If ctl.Text = " " Or ctl.Text = "　" Then
    ctl.Text = ""
  End If
  
  var1 = Filter(var1, ctl.Text, True, vbTextCompare)
  'テキストモードで、テキストボックスの値を含む要素のみに絞込み
  'ctl.Text = "" の場合は、絞込みされない
  
  getListArray = var1
End Function



'テキストボックスごとのリスト配列取得
Private Function getListArrayByTextBox(ByVal ctl As Control) As Variant
  Dim var1 As Variant
  Select Case ctl.Name
    Case "txt1"
      var1 = シート1.Range("O1:O18")
    Case "txt2"
      var1 = シート1.Range("P1:P18")
    Case Else
      MsgBox "???"
  End Select
  
  getListArrayByTextBox = WorksheetFunction.Transpose(var1)
  'Transposeで1次元配列に
  
End Function
```
### スピンボタン　　テキストボックスと連動させる使い方は、結構出番あるかも
```
ユーザーフォーム1.xlsm　SpinBtnFormフォーム


*************   SpinBtnForm  ********************

Option Explicit

'値が変化した時
Private Sub spin1_Change()
  Me.txt1.Text = Me.spin1.Value  'spin1のValueをtxt1のテキストに
End Sub

'UPボタンが押された時
Private Sub spin1_SpinDown()
  Me.txt2.Text = "Down"
End Sub

'DOWNボタンが押された時
Private Sub spin1_SpinUp()
  Me.txt2.Text = "Up"
End Sub


'フォーム初期化時
Private Sub UserForm_Initialize()
  '※以下のスピンボタンプロパティの数値は、整数のみ設定可能
  With Me.spin1
    .Value = 5         'spin1の値を設定
    .max = 30          '最大値
    .Min = 1           '最小値
    .SmallChange = 2   'Up、Downの変化数値
  End With
End Sub

'txt1に直接入力があった場合は、spin1の値と連動させる
Private Sub txt1_AfterUpdate()
  Dim xNum As Long
  
  '数値であり、sipn1の最大値・最小値の範囲に入っているかを確認
  If IsNumeric(Me.txt1.Text) Then
    xNum = CLng(Me.txt1.Text)
    If xNum >= Me.spin1.Min And xNum <= Me.spin1.max Then
      Me.spin1.Value = xNum
      Exit Sub
    End If
  End If
  
  Me.txt1.Text = 5 '不適当な入力値の場合は、標準の5に設定
End Sub
```