自分用のメモなので、形は整ってないです。
ユーザーフォーム 基本
******************* 標準モジュール ****************
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