2022/11/06

項目追加が可能なコンボボックスリスト




コンボボックスは、項目を選択する時だけドロップダウンボタンによりリストが現れるコントロールです。最上部のテキスト部に項目の先頭ワードを入力すれば、リスト項目をジャンプすることもできます。
但し選択できるのはリスト上に存在する項目のみで、通常はユーザーが自由に項目を作ることは出来ません。今回は、リストに無いものは作成ができるコンボボックスを紹介します。

手法として、下記の４種類を考えました。
  1. ボタンでInputBoxを表示させ新項目を入力
  2. コンボボックスのテキスト部に新項目を入力
  3. リスト内の(新規)を選択しInputBoxから新項目を入力
  4. リスト上で右クリックしInputBoxから新項目を入力

１．概要

１ー１．ボタンでInputBoxを表示させ新項目を入力

この手法のみ「追加項目の挿入位置を指定可能」です。
ボタンでInputBoxを表示させ新項目を入力する手順
図１

まずリストのどの位置に挿入するかをリストを開いて指定①します。例えば２番目に挿入したければ２番目の項目を選択します。この場合、現在の２番目の項目（図１では「B」）は３番目になります。なお、リストの最後尾に挿入したいのであれば、リストは未選択の状態にします。
挿入位置が決まったら、上部の「データ追加」ボタン②をクリックします。するとInputBox③が表示されますので、追加項目を入力④し、OKボタン⑤をクリックします。その結果、指定の位置に項目が追加されます（図１の右側）。

１ー２．コンボボックスのテキスト部に新項目を入力

この手法は、追加される位置は固定です。今回の場合はリストの最後に項目が追加されます。
コンボボックスのテキスト部に新項目を入力する手順
図２

コンボボックスのテキストボックス部に追加する項目を入力①します。入力後に隣の「決定」ボタン②をクリックします。
その結果、リストの最後に項目が追加されます（図２の右側）。

１ー３．リスト内の(新規)を選択しInputBoxから新項目を入力

この手法も、追加される位置は固定です。今回の場合はリストの最後に項目が追加されます。
リスト内の(新規)を選択しInputBoxから新項目を入力する手順
図３

まずリストを広げ、最上段にある「（新規）」の項目をクリック①します。するとInputBox②が表示されますので、追加項目を入力③し、OKボタンをクリック④します。
その結果、リストの最後に項目が追加されます（図３の右側）。

１ー４．リスト上で右クリックしInputBoxから新項目を入力

この手法も、追加される位置は固定です。今回の場合はリストの最後に項目が追加されます。
リスト上で右クリックしInputBoxから新項目を入力する手順
図４

リストを広げてから、そのリスト上でマウス右クリック①しても良いですし、広げずにコンボボックス上でマウス右クリックをしてもOKです。
するとInputBox②が表示されますので、追加項目を入力③し、OKボタンをクリック④します。
その結果、リストの最後に項目が追加されます（図４の右側）。

２．マクロ等

コンボボックスのリストデータがプログラム内でどのような形になっているかは、システムによって様々だと思いますが、ここでは「１次元配列データ」をコンボボックスのリストにするとして説明をします。また、そのデータは「ワークシート上に保存」することとします。
コンボボックスはユーザーフォーム上に作られたものとし、追加された新リスト項目は、ワークシート上に上書き保存されます。

２ー１．ワークシートと共通マクロ

２－１－１．ワークシート

リストデータは図５のように、Sheet1のA1セルから縦方向に並べて保存されることにします。
また「サンプルファイル」では、ユーザーフォームはSheet1に並べたボタンから起動可能です。
ワークシート上のデータ範囲等
図５

２－１－２．標準モジュール

まず、コンボボックスのリストのデータ配列を「配列変数DataArray」としてPublic宣言します（図６）。
  1. '==========　⇩(1)　モジュール変数の宣言　============
  2. Public DataArray As Variant 　　 '←コンボボックスのリストデータ配列
図６

今回は、データをワークシートから拾ってきて配列の形にしますが、単純にデータを配列に取り込んでもデータが複数個であればちゃんと配列になります。しかしデータがゼロ個の時には「Empty」になってしまいますし、１個の時には「配列では無い変数」になってしまいます。

データの個数により型が変わってしまうと、処理する側が複雑になってしまいますので、今回は図７のように「個数に関わらず、全て配列」の形になるようにします。
またデータが「ゼロ個か１個か」を区別するために、ゼロ個の場合はインデックスをゼロに、１個以上の場合はインデックスは１始まりとすることにしました。

データ個数での配列の形の変化
図７

Sheet1からデータを取り出し、配列DataArrayに代入するのが図８のDataInプロシージャです。このプロシージャは、各ユーザーフォームを起動する時に呼び出されます。
  1. '==========　⇩(2)　データを取得し配列化　============
  2. Public Sub DataIn()
  3. 　Dim buf(1 To 1) As Variant 　　 '←データが１個の時の仮配列
  5. 　If Sheets("sheet1").Range("a1") = "" Then
  6. 　　ReDim DataArray(0 To 0)
  7. 　Else
  8. 　　DataArray = WorksheetFunction.Transpose(Sheets("sheet1").Range("a1").CurrentRegion)
  10. 　　If IsArray(DataArray) = False Then
  11. 　　　buf(1) = DataArray
  12. 　　　DataArray = buf
  13. 　　End If
  15. 　End If
  16. End Sub
図８

今回は、データはSheet1のA1セルから下方向に存在することになっています。
ですので１４行目「If Sheets("sheet1").Range("a1") = "" Then」で空白セルか否かを調べます。空白セルだとすると「データは１つも無い」事になりますので、１５行目「ReDim DataArray(0 To 0)」で「１次元配列でインデックスはゼロの１要素配列」を作成します。
これは、図７で説明した「データ数が0個」の時に相当します。また、リストデータは無いので、配列要素内には何も入れません。

データが１つ以上ある場合（１６行目「Else」）は、１７行目「DataArray = WorksheetFunction.Transpose(Sheets("sheet1").Range("a1").CurrentRegion)」で、A1セルから連続しているデータを配列にしています。
連続データ範囲は「Sheets("sheet1").Range("a1").CurrentRegion」で取得できますが、今回「縦方向（＝そのままでは２次元配列になってしまう）」にデータが並んでいるので「横方向（＝１次元配列）」にするためにTranspose関数を使用しています。

Transpose関数で行列逆転した場合、データが２個以上の場合は「２次元配列→１次元配列」になるのですが、１個の場合は「２次元配列→普通の変数」になってしまいます。
ですので１９行目「If IsArray(DataArray) = False Then」で、１７行目で作られたDataArrayが「配列か否か」を調べ、配列では無かった場合（＝データは１個）は２０行目「buf(1) = DataArray」で、１２行目で宣言しておいた配列bufにデータの値を代入し、２１行目「DataArray = buf」でDataArrayを「配列化」しています。

配列データをSheet1に戻す（＝出力）のが図９です。各ユーザーフォーム内で項目が追加された際に、実行されます。
  1. '==========　⇩(3)　配列データをシート上に保存　============
  2. Public Sub DataOut()
  3. 　Sheets("sheet1").Range("a1").Resize(UBound(DataArray, 1), 1) = WorksheetFunction.Transpose(DataArray)
  4. End Sub
図９

３２行目「Sheets("sheet1").Range("a1").Resize(UBound(DataArray, 1), 1) = WorksheetFunction.Transpose(DataArray)」で、A1セルを基準としたセル範囲に、配列DataArrayを縦方向にしてから貼り付けています。
なお、今回は「リスト項目は、増えるだけで減らない」仕様としているため、「新しいデータを上書き」していますが、項目が減る可能性がある場合には、元のデータを消去してから新しいデータを貼り付ける必要があります。

Sheet1上のボタンから呼び出されるのが図１０です。
  1. '==========　⇩(4)　各ユーザーフォームを呼び出し　============
  2. Public Sub start1() 　　 '←ボタンでInputBoxを表示させ新項目を入力
  3. 　UserForm1.Show
  4. End Sub
  6. Public Sub start2() 　　 '←コンボボックスのテキスト部に新項目を入力
  7. 　UserForm2.Show
  8. End Sub
  10. Public Sub start3() 　　 '←リスト内の(新規)を選択しInputBoxから新項目を入力
  11. 　UserForm3.Show
  12. End Sub
  14. Public Sub start4() 　　 '←リスト上で右クリックしInputBoxから新項目を入力
  15. 　UserForm4.Show
  16. End Sub
図１０

Sheet1上のボタンに登録されている図１０の各プロシージャを起動すると、各ユーザーフォームがモーダル（フォーム以外は操作不可状態）で呼び出されます。

なお、ここではモーダルで呼び出していますが、もしモードレスで呼び出してしまうと「複数のフォームが呼び出せる」ことになってしまいます。すると、一方のフォームで項目追加してしまうと他方のフォームのリストのサイズが配列DataArrayのサイズと異なってしまうため、意図しない結果となってしまう可能性があります。システムでも共通のデータを複数のフォーム上で使用する場合は、フォームの起動方法に注意が必要です。

２ー２．ボタンでInputBoxを表示させ新項目を入力（UserForm1）

２－２－１．フォームのレイアウト

フォーム上には、ComboBoxとCommandButtonを１つずつ配置します。ボタンのCaptionは配置時に設定しています。
UserForm1のレイアウト
図１１

２－２－２．フォームモジュール

Sheet1上のボタンから、図１０の４２行目を通じてフォーム（UserForm1）が呼び出され、フォーム起動時にまず実行されるのが図１２です。
  1. '==========　⇩(5)　フォームの初期化　============
  2. Private Sub UserForm_Activate()
  3. 　Me.Caption = "ボタンでInputBox表示させ項目追加"
  4. 　Me.ComboBox1.MatchRequired = True
  5. 　Call DataIn
  6. 　Call make_CB1
  7. End Sub
図１２

６２行目「Me.Caption = "ボタンでInputBox表示させ項目追加"」では、フォームのタイトルを作成しています。

６３行目「Me.ComboBox1.MatchRequired = True」は、コンボボックスのテキスト部（ユーザーがキー入力できる部分）には、リストにあるものしか認めないようにしています。この設定により、リストに無いものを入力してから他のコントロール（今回の場合は「データ追加」ボタン）に移動しようとしても、図２６のような「プロパティの値が無効です」とメッセージが出て移動できません。
この設定は必須では無いかもしれませんが、今回のようにInputBoxで新項目を追加するタイプでは「例え、テキスト部に新項目を入力しても無視」されるために、「入力できない方が、ユーザーには分かりやすい」のでは、と考えて設定しています。
（逆に言うと「コンボボックスのテキスト部に新項目を入力（図２）」する方法のような「テキスト部に文字列を入力」するタイプと区別するためです。）

なお、テキスト部にリストにない文字列を入力してしまうと、BS（バックスペース）キーで文字列を消してもエラーは解除できません。ESCキーなどで文字列をキャンセルしてからボタンに移動する必要があります。

６４行目「Call DataIn」では、標準モジュールの図８を呼び出し、シート上のリストデータを配列DataArrayに格納します。
６５行目「Call make_CB1」では、次の図１３を呼び出し、コンボボックスのリストを作成します。

フォーム起動時（図１２の６５行目）と、データを追加した後（図１５の１３３行目）に呼び出されるのが図１３です。
引数として、省略可能のselectNoを受け取ります。このselectNoは、コンボボックスのリストの選択項目（ListIndexの番号）としています。
  1. '==========　⇩(6)　コンボボックスのリスト作成　============
  2. Private Sub make_CB1(Optional selectNo As Integer = -1)
  3. 　Dim i As Integer 　　 '←リスト項目数
  5. 　Me.ComboBox1.Clear
  7. 　For i = 1 To UBound(DataArray, 1)
  8. 　　Me.ComboBox1.AddItem DataArray(i)
  9. 　Next i
  11. 　Me.ComboBox1.ListIndex = selectNo
  13. End Sub
図１３

７４行目「Me.ComboBox1.Clear」では、まずリストをクリアします。フォーム起動時には当然データは無いのですが、データ追加時は「起動時の表示データ」が残っているためにクリアが必要です。

７６行目「For i = 1 To UBound(DataArray, 1)」では、配列DataArrayの要素数だけカウンタ変数ｉを回します。
７７行目「Me.ComboBox1.AddItem DataArray(i)」では、配列DataArrayの要素の値を１つ１つコンボボックスのリストに追加していきます。

８０行目「Me.ComboBox1.ListIndex = selectNo」は、引数が指定された場合は、そのリスト番号を選択状態にします。引数が指定されなかった場合は既定値が「-1」ですので、リストは未選択状態となります。

「データ追加」ボタンをクリックした時に呼び出されるのが図１４です。９２行目「Call NewDataIn」で図１５を呼び出します。
  1. '==========　⇩(7)　データ追加ボタンをクリック　============
  2. Private Sub CommandButton1_Click()
  3. 　Call NewDataIn
  4. End Sub
図１４

図１４の９２行目から呼び出されるのが図１５です。
  1. '==========　⇩(8)　リストデータを追加　============
  2. Private Sub NewDataIn()
  3. 　Dim NewItem As String 　　　 '←新たに追加する項目ワード
  4. 　Dim buf() As Variant 　　　　 '←仮の新データ配列
  5. 　Dim NewIndex As Integer 　　 '←新データ配列のインデックス
  6. 　Dim OldIndex As Integer 　　 '←旧データ配列のインデックス
  7. 　Dim NewNo As Integer 　　　 '←追加した配列の位置
  9. 　NewItem = Trim(InputBox("新選択項目を入力して下さい"))
  11. 　If NewItem = "" Then Exit Sub
  13. 　ReDim buf(1 To UBound(DataArray, 1) + 1)
  15. 　If Me.ComboBox1.ListIndex = -1 Then
  16. 　　NewNo = UBound(buf, 1)
  17. 　Else
  18. 　　NewNo = Me.ComboBox1.ListIndex + 1
  19. 　End If
  21. 　OldIndex = 1
  22. 　For NewIndex = 1 To UBound(buf, 1)
  23. 　　If NewIndex = NewNo Then
  24. 　　　buf(NewIndex) = NewItem
  25. 　　Else
  26. 　　　buf(NewIndex) = DataArray(OldIndex)
  27. 　　　OldIndex = OldIndex + 1
  28. 　　End If
  29. 　Next NewIndex
  31. 　DataArray = buf
  33. 　Call DataOut
  34. 　Call make_CB1(NewNo - 1)
  35. 　MsgBox "項目「" & NewItem & "」を追加しました"
  37. End Sub
図１５

１０８行目「NewItem = Trim(InputBox("新選択項目を入力して下さい"))」ではInputBoxを表示させ、その戻り値を「前後のスペースを除いて」から変数NewItemに代入しています。
InputBox関数はユーザーが入力した文字列を戻してくれますが、OKボタンでは無く「キャンセル」ボタンをクリックしたり、ダイアログ右上の×印をクリックしたりすると、「値ゼロの文字列」を戻してきます（詳細は「InputBox関数とInputBoxメソッドの戻り値」を参照下さい）。
しかし、Trim関数で両端のスペースを削除すると、値ゼロの文字列は「長さゼロの文字列」に変わります。

その戻された値（変数NewItem）を、１１０行目「If NewItem = "" Then Exit Sub」で「長さゼロの文字列か否か」を調べ、長さゼロの文字列だった場合は、処理を中止（Exit Sub）します。
（何も入力しないでOKボタン、スペースだけ入力しOKボタン、キャンセルボタン、右上×印クリック　のいずれかの時）

意味のある文字列が入力されてOKボタンがクリックされた時には、まず１１２行目「ReDim buf(1 To UBound(DataArray, 1) + 1)」で、現在のリスト（配列DataArray）のサイズよりも「１つ大きなサイズ」の仮配列bufを作成します。インデックスの付け方は、元の配列DataArrayと合わせて１始まりとしています。
なお元のリストが空（DataArrayのインデックス＝ゼロ）の場合は、「UBound(DataArray, 1) = 0」ですので、「buf(1 To 1)」の仮配列を作ることになります。

１１４～１１８行目では、新項目を入れる位置を計算しています。コンボボックスのリストで選択した位置に新項目を入れ、リストが未選択状態（ListIndex = -1 ）の時には一番最後に追加をします。
１１４行目「If Me.ComboBox1.ListIndex = -1 Then」で、未選択状態の時は１１５行目「NewNo = UBound(buf, 1)」で変数NewNoにリストの最後の位置を指定します。
リストが選択状態（１１６行目「Else」）の時は、１１７行目「NewNo = Me.ComboBox1.ListIndex + 1」でリストの選択位置を指定します。ListIndex値は一番上がゼロですが、変数NewIndexは１始まりのインデックスとしている都合上「＋１」しています。

１２０～１２８行目では、仮の配列bufに新しいリストを組み立てています。
まず元のリストの順番は変数OldIndexとし、１２０行目「OldIndex = 1」で初期値を１と置き、元のリストの処理を行った時のみ、１２６行目「OldIndex = OldIndex + 1」で１つずつ増加させています。

１２１行目「For NewIndex = 1 To UBound(buf, 1)」で、仮の新しい配列bufの数だけカウンタ変数NewIndexを回します。変数NewIndexは、新しい配列bufの要素の位置になります。
１２２行目「If NewIndex = NewNo Then」で、新入力項目の位置（NewNo）が見つかった時には、１２３行目「buf(NewIndex) = NewItem」で新入力項目の値を新しい配列bufに格納します。
それ以外（１２４行目「Else」）は全て元のリスト配列（DataArray）のデータですので、１２５行目「buf(NewIndex) = DataArray(OldIndex)」で、元の値を新しい配列bufにコピーします。

元のリストの「OldIndex番目」のデータ処理が終わったら、１２６行目「OldIndex = OldIndex + 1」で、OldIndexを１つ増やします。

新しいリストを組み立て代入が終了したら、１３０行目「DataArray = buf」で仮配列（buf）を元の配列（DataArray）に置き換えます。
「配列のサイズが異なるけど大丈夫？」と思われるかもしれませんが、問題無く置き換わってくれます。心配であれば、置き換えの前に「Erase DataArray」などで元の配列を初期化してから新たに代入して下さい。

リストが新しくなりましたので、まず１３２行目「Call DataOut」で、標準モジュールの図９を呼び出し、新しいリストをワークシート上に出力（上書き）します。
１３３行目「Call make_CB1(NewNo - 1)」では図１３を呼び出し、コンボボックスのリストを更新しています。この際に引数を指定していますので、「NewNo - 1（ListIndexの番号にするために"-1"している）」の位置（＝新たに追加した項目の位置）の項目を選択状態にします。

１３４行目「MsgBox "項目「" & NewItem & "」を追加しました"」は、不要な場合もあるでしょうが、追加した事をユーザーに知らせています。逆にこのメッセージが出ない場合は項目が追加されていないことになります。

２ー３．コンボボックスのテキスト部に新項目を入力（UserForm2）

２－３－１．フォームのレイアウト

フォーム上には、ComboBoxとCommandButtonを１つずつ配置します。ボタンのCaptionは配置時に設定しています。
UserForm2のレイアウト
図１６

２－３－２．フォームモジュール

Sheet1上のボタンから、図１０の４６行目を通じてフォーム（UserForm2）が呼び出され、フォーム起動時にまず実行されるのが図１７です。
  1. '==========　⇩(9)　フォームの初期化　============
  2. Private Sub UserForm_Activate()
  3. 　Me.Caption = "テキスト部に新項目を入力"
  4. 　Call DataIn
  5. 　Call make_CB1
  6. End Sub
図１７

１４２行目「Me.Caption = "テキスト部に新項目を入力"」で、フォームのタイトルを作成しています。
１４３行目「Call DataIn」では、標準モジュールの図８を呼び出し、シート上のリストデータを配列DataArrayに格納します。
１４４行目「Call make_CB1」では、次の図１８を呼び出し、コンボボックスのリストを作成します。

なお、図１２の６３行目では「Me.ComboBox1.MatchRequired = True」を設定していましたが、今回は「テキスト部にリストには無い項目を入力」するのが目的のため、設定はしません。明示したいのであれば、既定の「Me.ComboBox1.MatchRequired = False」と設定します。

フォーム起動時（図１７の１４４行目）と、データを追加した後（図２０の１９１行目）に呼び出されるのが図１８です。
引数として、省略可能のselectNoを受け取ります。このselectNoは、コンボボックスのリストの選択項目（ListIndexの番号）としています。内容は図１３と全く一緒です。
  1. '==========　⇩(10)　コンボボックスのリスト作成　============
  2. Private Sub make_CB1(Optional selectNo As Integer = -1)
  3. 　Dim i As Integer 　 '←リスト項目数
  5. 　Me.ComboBox1.Clear
  7. 　For i = 1 To UBound(DataArray, 1)
  8. 　　Me.ComboBox1.AddItem DataArray(i)
  9. 　Next i
  11. 　Me.ComboBox1.ListIndex = selectNo
  13. End Sub
図１８

１５４行目「Me.ComboBox1.Clear」では、まずリストをクリアします。
１５６行目「For i = 1 To UBound(DataArray, 1)」では、配列DataArrayの要素の数だけカウンタ変数ｉを回します。
１５７行目「Me.ComboBox1.AddItem DataArray(i)」では、配列DataArrayの要素の値をリストに追加していきます。
１６０行目「Me.ComboBox1.ListIndex = selectNo」は、引数が指定された場合は、そのリスト番号を選択状態にします。引数が指定されなかった場合は既定値が「-1」ですので、リストは未選択状態となります。

「決定」ボタンをクリックした時に呼び出されるのが図１９です。１７２行目「Call NewDataIn」で図２０を呼び出します。
  1. '==========　⇩(11)　決定ボタンをクリック　============
  2. Private Sub CommandButton1_Click()
  3. 　Call NewDataIn
  4. End Sub
図１９

図１９の１７２行目から呼び出されるのが図２０です。
  1. '==========　⇩(12)　リストデータを追加　============
  2. Private Sub NewDataIn()
  3. 　Dim NewItem As String 　 '←新たに追加する項目ワード
  5. 　NewItem = Trim(Me.ComboBox1.Value)
  6. 　If Not Me.ComboBox1.ListIndex = -1 Or NewItem = "" Then Exit Sub
  8. 　ReDim Preserve DataArray(1 To UBound(DataArray, 1) + 1)
  9. 　DataArray(UBound(DataArray, 1)) = NewItem
  11. 　Call DataOut
  12. 　Call make_CB1(UBound(DataArray, 1) - 1)
  13. 　MsgBox "項目「" & NewItem & "」を追加しました"
  15. End Sub
図２０

この仕様では、新項目の入力にはInputBoxを使用せず、コンボボックス最上段のテキスト部に入力された文字列を使用します。ですので１８４行目「NewItem = Trim(Me.ComboBox1.Value)」で、テキスト部の文字列を両端スペースを除いてから、変数NewItemに代入します。
なおコンボボックスのValue値ですので、リストのどれかを選択した状態で「決定」ボタンをクリックした時には、その選択している値が変数NewItemに入ることになります。

１８５行目「If Not Me.ComboBox1.ListIndex = -1 Or NewItem = "" Then Exit Sub」では、If文の条件が２つあります。
１つ目が「Not Me.ComboBox1.ListIndex = -1」で、テキスト部に新たな文字を入力したのではなく、リストの既存項目を選んだ（テキスト部にリスト項目と同じ文字列を入れた時も同じ）場合にTrueとなります。
２つ目が「NewItem = ""」で、テキスト部に何も入れなかった（またはスペースだけを入れた）場合もTrueとなります。
そのどちらかが成立するときに「Exit Sub」で処理を中止します。

テキスト部に正しく「新たな項目を入力」した時には、１８７行目「ReDim Preserve DataArray(1 To UBound(DataArray, 1) + 1)」で、配列DataArrayを「１つ大きなサイズ」に変更します。その際、Preserveキーワードを付けて「元の値を消さない」ようにしています。つまりサイズを１つ大きくしているため、一番最後の要素が増えたことになります。
１８８行目「DataArray(UBound(DataArray, 1)) = NewItem」では、その最後の要素の場所に、新項目を格納しています。

配列DataArrayが新しくなりましたら、１９０行目「Call DataOut」で、標準モジュールの図９を呼び出し、新しいリストをワークシート上に出力（上書き）します。
そして１９１行目「Call make_CB1(UBound(DataArray, 1) - 1)」で、図１８を呼び出し、コンボボックスのリストを更新します。その際に引数として「UBound(DataArray, 1) - 1（配列DataArrayの最後のListIndex番号）」を指定することで、追加した新項目を選択状態にします。
１９２行目「MsgBox "項目「" & NewItem & "」を追加しました"」では、追加した事をユーザーに知らせています。

この仕様では、リスト内の既存の項目を追加しようとしても、既存項目が選択されてしまいます。ですので項目が重複することが無いのが特徴です。

２ー４．リスト内の(新規)を選択しInputBoxから新項目を入力（UserForm3）

２－４－１．フォームのレイアウト

フォーム上には、ComboBoxを１つ配置します。
UserForm3のレイアウト
図２１

２－４－２．フォームモジュール

Sheet1上のボタンから、図１０の５０行目を通じてフォーム（UserForm3）が呼び出され、フォーム起動時にまず実行されるのが図２２です。
  1. '==========　⇩(13)　フォームの初期化　============
  2. Private Sub UserForm_Activate()
  3. 　Me.Caption = "リスト内の(新規)を選択しInputBox入力"
  4. 　Me.ComboBox1.MatchRequired = True
  5. 　Call DataIn
  6. 　Call make_CB1
  7. End Sub
図２２

２０２行目「Me.Caption = "リスト内の(新規)を選択しInputBox入力"」では、フォームのタイトルを作成しています。
２０３行目「Me.ComboBox1.MatchRequired = True」は、コンボボックスのテキスト部（ユーザーがキー入力できる部分）には、リストにあるものしか認めないようにしています。
２０４行目「Call DataIn」では、標準モジュールの図８を呼び出し、シート上のリストデータを配列DataArrayに格納します。
２０５行目「Call make_CB1」では、次の図２３を呼び出し、コンボボックスのリストを作成します。

フォーム起動時（図２２の２０５行目）と、データを追加した後（図２５の２５４行目）に呼び出されるのが図２３です。
引数として、省略可能のselectNo（リストの選択項目（ListIndexの番号））を受け取ります。
  1. '==========　⇩(14)　コンボボックスのリスト作成　============
  2. Private Sub make_CB1(Optional selectNo As Integer = -1)
  3. 　Dim i As Integer 　　 '←リスト項目数
  5. 　Me.ComboBox1.Clear
  7. 　Me.ComboBox1.AddItem "(新規)"
  9. 　For i = 1 To UBound(DataArray, 1)
  10. 　　Me.ComboBox1.AddItem DataArray(i)
  11. 　Next i
  13. 　Me.ComboBox1.ListIndex = selectNo
  15. End Sub
図２３

２１４行目「Me.ComboBox1.Clear」で、リストをクリアします。
２１６行目「Me.ComboBox1.AddItem "(新規)"」では、まず「リストの先頭」に「(新規)」という項目を並べます。この(新規)を選択した時に、InputBoxが表示されて新項目が入力できるようにします。
２１８～２２０行目は、「(新規)」の下に続けて選択可能な項目を並べていきます。
２１８行目「For i = 1 To UBound(DataArray, 1)」では、配列DataArrayの要素の数だけカウンタ変数ｉを回します。
２１９行目「Me.ComboBox1.AddItem DataArray(i)」では、配列DataArrayの要素の値をリストに追加していきます。

２２２行目「Me.ComboBox1.ListIndex = selectNo」は、引数で指定された場合は、そのリスト番号を選択状態にします。引数として指定されなかった場合は既定値が「-1」ですので、リストは指未選択状態となります。

「(新規)」を含めてリストを選択した時に呼び出されるのが図２４です。２３２行目「If Me.ComboBox1.ListIndex = 0 Then Call NewDataIn」で、「(新規)」を選択した時だけ図２４を呼び出します。
その他の項目を選択した時には、そのまま項目が選択状態になります。
  1. '==========　⇩(15)　リストを選択　============
  2. Private Sub ComboBox1_Change()
  3. 　If Me.ComboBox1.ListIndex = 0 Then Call NewDataIn
  4. End Sub
図２４

「(新規)」を選択した時に、図２４の２３２行目から呼び出されるのが図２５です。
  1. '==========　⇩(16)　リストデータを追加　============
  2. Private Sub NewDataIn()
  3. 　Dim NewItem As String 　　　 '←新たに追加する項目ワード
  5. 　NewItem = Trim(InputBox("新選択項目を入力して下さい"))
  6. 　If NewItem = "" Then
  7. 　　Application.SendKeys "{ESC}"
  8. 　　Exit Sub
  9. 　End If
  11. 　ReDim Preserve DataArray(1 To UBound(DataArray, 1) + 1)
  12. 　DataArray(UBound(DataArray, 1)) = NewItem
  14. 　Call DataOut
  15. 　Call make_CB1(UBound(DataArray, 1))
  16. 　MsgBox "項目「" & NewItem & "」を追加しました"
  18. End Sub
図２５

２４４行目「NewItem = Trim(InputBox("新選択項目を入力して下さい"))」ではInputBoxを表示させ、その戻り値を「前後のスペースを除いて」から変数NewItemに代入しています。
２４５行目「If NewItem = "" Then」では、入力した値が無効（キャンセルボタンやダイアログ右上×印クリック　を含む）だった場合は、２４６～２４７行目を実行します。
この時点はInputBoxダイアログが消えた後なので、フォーカスはComboBox1にある状態です。その状態の時に２４６行目「Application.SendKeys "{ESC}"」で「ESCキー」を発行することで、「選択した文字列（ここでは "(新規)"）を削除」することになります。
コンボボックスのテキスト部を未選択状態にした後、２４７行目「Exit Sub」で処理を中止します。
寄り道
コンボボックスを図２２の２０３行目のように「.MatchRequired = True」設定した場合、コンボボックスのテキスト部に一旦入力（リストを選択しても同じ）をしてしまうと、テキスト部のデータを削除（Me.ComboBox1.Value = ""）しても、選択状態を解除（Me.ComboBox1.ListIndex = -1）しても、コンボボックスは「テキスト部の上には、リストに無い項目が入力されている」と判断するようです。そのため、コンボボックスからフォーカスが離れる時には図２６のような「プロパティの値が無効です」とエラーが発生してしまいます。
プロパティ値無効のエラー
図２６

但し、一度もテキスト部に入力をしていない状態ではエラーは発生しませんので、テキスト部に一旦文字列を入力したか否かでプロパティのどこかに違いがあるのでは、と思い調べてみましたが、残念ながら発見できませんでした。
ですので「ESCキー」をマクロ側から発行し、選択前の状態に戻すことで、エラー発生を抑える事にしました。

なお「.MatchRequired = True」の設定がされていると、コンボボックスのテキスト部にリスト以外の文字列を入れたまま、項目追加処理をせずに異なるコントロールに移動しようとすると、当然「プロパティ値が無効」のエラーが出てしまいます。
システムにする際は、コンボボックスの未選択状態をチェックする機能が、別に必要になると思います。

２ー５．リスト上で右クリックしInputBoxから新項目を入力（UserForm4）

２－５－１．フォームのレイアウト

フォーム上には、ComboBoxを１つ配置します。
UserForm4のレイアウト
図２７

２－５－２．フォームモジュール

Sheet1上のボタンから、図１０の５４行目を通じてフォーム（UserForm4）が呼び出され、フォーム起動時にまず実行されるのが図２８です。
  1. '==========　⇩(17)　フォームの初期化　============
  2. Private Sub UserForm_Activate()
  3. 　Me.Caption = "リスト上で右クリックしInputBox入力"
  4. 　Me.ComboBox1.MatchRequired = True
  5. 　Call DataIn
  6. 　Call make_CB1
  7. End Sub
図２８

２６２行目「Me.Caption = "リスト上で右クリックしInputBox入力"」で、フォームのタイトルを作成しています。
２６３行目「Me.ComboBox1.MatchRequired = True」は、コンボボックスのテキスト部（ユーザーがキー入力できる部分）には、リストにあるものしか認めないようにしています。
２６４行目「Call DataIn」では、標準モジュールの図８を呼び出し、シート上のリストデータを配列DataArrayに格納します。
２６５行目「Call make_CB1」では、次の図２９を呼び出し、コンボボックスのリストを作成します。

フォーム起動時（図２８の２６５行目）と、データを追加した後（図３５の３２８行目）に呼び出されるのが図２９です。
引数として、省略可能のselectNoを受け取ります。このselectNoは、コンボボックスのリストの選択項目（ListIndexの番号）となります。内容は図１３、図１８と全く一緒です。
  1. '==========　⇩(18)　コンボボックスのリスト作成　============
  2. Private Sub make_CB1(Optional selectNo As Integer = -1)
  3. 　Dim i As Integer
  5. 　Me.ComboBox1.Clear
  7. 　For i = 1 To UBound(DataArray, 1)
  8. 　　Me.ComboBox1.AddItem DataArray(i)
  9. 　Next i
  11. 　Me.ComboBox1.ListIndex = selectNo
  12. End Sub
図２９

２７４行目「Me.ComboBox1.Clear」では、まずリストをクリアします。
２７６行目「For i = 1 To UBound(DataArray, 1)」では、配列DataArrayの要素の数だけカウンタ変数ｉを回します。
２７７行目「Me.ComboBox1.AddItem DataArray(i)」では、配列DataArrayの要素の値をリストに追加していきます。
２８０行目「Me.ComboBox1.ListIndex = selectNo」は、引数が指定された場合は、そのリスト番号を選択状態にします。引数が指定されなかった場合は既定値が「-1」ですので、リストは未選択状態となります。

コンボボックス上でマウスクリックした時に呼び出されるのが図３０です。左右どちらのクリックでも呼び出されます。
  1. '==========　⇩(19)　リスト上を右クリック　============
  2. Private Sub ComboBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  4. 　If Button = 2 Then
  5. 　　Me.ComboBox1.Clear
  6. 　　Call NewDataIn
  7. 　End If
  8. End Sub
図３０

このMouseUpイベントプロシージャでは「Button」「Shift」「X」「Y」の４つの引数を受け取ります。
第一引数のButtonは図３１の値になり、第二引数のShiftは図３２の値になります。また第三・第四引数のXとYは、オブジェクトであるComboBox1の左上角を起点とした「マウスをクリックした位置（単位：ポイント）」です。
Buttonの値
定数値内容
fmButtonLeft1左ボタンが押された
fmButtonRight2右ボタンが押された
fmButtonMiddle4中央ボタンが押された
図３１

Shiftの値
値内容
0Shift・Ctrl・Altのどのキーも押されていない
1Shiftキーが押された
2Ctrlキーが押された
3Shiftキー + Ctrlキーが押された
4Altキーが押された
5Altキー + Shiftキーが押された
6Altキー + Ctrlキーが押された
7Altキー + Shift キー + Ctrl キーが押された
図３２

今回は、クリックしたボタンが「右」だった場合に新項目を入力できるようにしています。左クリックはリストにある既項目を選択するために使用するからです。
そのため第一引数のButtonを使い、２９３行目「If Button = 2 Then」で、「クリックしたのが右ボタン」の時にのみ２９４～２９５行目を実行させます。

寄り道
ここで、コンボボックス上でマウス右クリックする様子を詳しく見てみます。
コンボボックス上での右マウスクリックのやり方３種
図３３

クリックする位置として、考えられるのは図３３のように３種類です。
①：リストを閉じた状態で、コンボボックスのテキスト部上でマウス右クリック
②：リストを開いた状態で、コンボボックスのテキスト部上でマウス右クリック
③：リストを開いた状態で、リスト上でマウス右クリック

①～③のどの場合でもMouseUpイベントが発生し、他の仕様と同じようにそのままInputBox入力の処理（Call NewDataIn）に移れると最初は考えました。
しかし図３３の③の「開いたリストの上でマウス操作」をした時だけ、InputBox処理後の「コンボボックスのリストを更新」内の「ComboBox.Clear」の部分（図２９で言うと２７４行目）で、図３４のようなエラーが発生するのです。エラーが発生してしまうと、Excelが異常終了したり、逆に終了できずにタスクマネージャーで終了させるしかない状態になります。
システムエラー
図３４

使用するメソッド類が悪いのかと思い、Clearメソッド抜きでAddItemメソッドを実行しても、やはりAddItemのところで同じエラーが発生します。また、InputBox関数では無くInputBoxメソッドでも同じでした。
また図３４のようなエラーダイアログが出ずに、異常終了する場合もありました。なお図３３では、リストが選択されていない状態からのマウス操作の図となっていますが、一旦リストを選択後に図３３のような操作をしても、同じです。

この種のエラーは「プログラム上のエラーでは無く、O/S上のメモリー等が原因」と説明されているようですが、異なるPC（O/SもWin10とWin11）で試してみても同じ結果となったので、VBAの特性の様な気がします。しかし私のPCだけがおかしい場合もあるので断定は出来ず、全く問題の無い方もいるかもしれません。

とりあえず状況をまとめると、「コンボボックスの開いたリスト上をクリック」→「InputBox関数を操作」→「コンボボックスのメソッド実行」をするとエラーが発生するようです。ComboBoxとInputBoxの相性が良くないのかもしれません。

しかし対策を見つけないと「この仕様は使えない」ことになりますので、色々試してみたところ「InputBox実行の前に、ComboBoxのClearメソッド」を実行する事で、エラー発生は無くなることが分かりました。
（ComboBoxの他のメソッドも試しましたが、Clear以外は効果ありませんでした。また「Me.ComboBox1.ListIndex = -1」で非選択状態にしたり、「Me.ComboBox2.SetFocus」等で他のコントロールにFocusを移すのもダメでした。）

但しInputBox前にリストをクリアしてしまうため、新項目入力をキャンセルした時も「リスト更新」をする必要があります。

上の「よりみち」で説明したように、「コンボボックスのリスト上を右クリック」した時でもエラーとならないようにするため、２９４行目「Me.ComboBox1.Clear」で一旦コンボボックスのリストをクリアしています。
そのため、図４の中央の図で「リストが一部消えている」のが確認できます。折角なら全部きれいに消したいのですが、Repaintメソッドでフォームを再描画しても残念ながら消えてくれませんでした。

次に２９５行目「Call NewDataIn」で、図３５を呼び出してInputBoxから新項目を入力し、リストに追加していきます。
寄り道
今回はMouseUpイベントを使用してマウスのクリックを検出しましたが、「MouseDownイベントでも同じでは？」と思われるかもしれません。しかし試してみるとMouseDownでは、不思議な現象が発生します。

マウス右クリックのやり方として、図３３の①②（コンボボックスのテキスト部の上でマウス右クリック）の操作をした場合、「MouseDownイベント」を使用するとInputBoxが「２回続けて表示」されるのです。
その２回とも、データの保存・リスト更新などは正常に処理されます。

１回目のInputBoxで「OKボタンをクリックしたのを、Excelが間違えて認識」しているのかと思いましたが、TabキーでOKボタンに移動しEnterキーで確定しても同じでした。
しかし「１つ上のよりみち」とは逆に、図３３の③の操作（リスト部で右クリック）では２回表示されないのです。

原因は今のところ分かりません。とにかく２回InputBoxが表示されても困るので、イベントとしてはMouseUpイベントを使用しています。

図３０の２９５行目から呼び出されるのが図３５です。
  1. '==========　⇩(20)　リストデータを追加　============
  2. Private Sub NewDataIn()
  3. 　Dim NewItem As String 　　　 '←新たに追加する項目ワード
  4. 　Dim select_item As Integer 　 '←選択する配列DataArrayの番号
  6. 　select_item = 0
  8. 　NewItem = Trim(InputBox("新選択項目を入力して下さい"))
  10. 　If NewItem = "" Then
  11. 　　Application.SendKeys "{ESC}"
  12. 　Else
  13. 　　ReDim Preserve DataArray(1 To UBound(DataArray, 1) + 1)
  14. 　　select_item = UBound(DataArray, 1)
  15. 　　DataArray(select_item) = NewItem
  16. 　　Call DataOut
  17. 　End If
  19. 　Call make_CB1(select_item - 1)
  20. 　If Not select_item = 0 Then MsgBox "項目「" & NewItem & "」を追加しました"
  21. End Sub
図３５

３１５行目「select_item = 0」では、変数select_itemにゼロを代入しています。InputBoxで新項目が入力されなかった時には、この値（select_item = 0）を使って３２８行目の「リスト更新（データ不変）＋未選択状態」が行われます。
なお変数select_itemは３１３行目でIntegerとして宣言しています。ですので初期値はゼロですが、ここでは明示的にゼロ指定をしています。

３１７行目「NewItem = Trim(InputBox("新選択項目を入力して下さい"))」ではInputBoxを表示させ、新項目を取得しています。取得した値は両端のスペースをTrim関数で削除した後、変数NewItemに代入しています。
３１９行目「If NewItem = "" Then」では、取得した値が新項目か否かを調べ、新項目では無い（何も入力せずにOKボタン、スペースのみを入力しOKボタン、キャンセルボタン、ダイアログ右上×印）場合は３２０行目を実行し、新項目だった場合は３２２～３２５行目を実行します。

キャンセル等をしたときの３２０行目「Application.SendKeys "{ESC}"」は、ComboBoxに向かって「ESCキー」を発行しています。このコードは、一旦リスト項目を設定した後でリスト未選択状態にした時に発生するエラーを抑えるものです。
今回のコンボボックスは、図２８の２６３行目で「リストのみを選択できる状態」に設定しています。この設定下では、一旦テキスト部に文字列が入ってしまうと、その後でリストを未選択状態に設定しても、他のコントロールに移動する時に「プロパティの値が無効です」というエラーが出てしまいます（「よりみち」参照）。
ですので「ESCキー」でリスト選択を無かったことにする必要があります。

新項目が入力された時（３２１行目「Else」）は、まず３２２行目「ReDim Preserve DataArray(1 To UBound(DataArray, 1) + 1)」で、新項目を追加するために、データ配列DataArrayのサイズを１つ増やします。その際、元のデータはそのまま使いますのでPreserveキーワードを付けます。

次に３２３行目「select_item = UBound(DataArray, 1)」で、配列の最後のインデックス番号を変数select_itemに代入します。そして３２４行目「DataArray(select_item) = NewItem」で、データを配列DataArrayの最後の要素に格納します。

新しいデータ配列DataArrayが完成したら、３２５行目「Call DataOut」で、データをワークシートに出力します。

今回の仕様は、図３０の２９４行目でリストをクリアしていますので、InputBoxで新項目が入力された場合だけでなく、キャンセル等をした時も「コンボボックスのリストの更新」が必要になります。
３２８行目「Call make_CB1(select_item - 1)」では、図２９を呼び出して「コンボボックスのリスト更新」をします。
その際、引数「select_item - 1」を指定していますが、新項目を追加した時には３２３行目で設定した「配列DataArrayの最後のインデックス番号」を、またキャンセル等をした時には３１５行目で設定した「初期値ゼロ」を渡します。この引数はListIndexの番号としているために「－１」しています。
（キャンセル時は「 0 - 1 」となりますので「-1」をListIndexに指定することになり、未選択状態となります。）

３２９行目「If Not select_item = 0 Then MsgBox "項目「" & NewItem & "」を追加しました"」では、新項目が作られた時だけ、コメントを出します。
コメントは、If文では無く３２５行目の後で実行してもよいのですが、その位置だとまだ「リストが作られておらず、テキスト部に何も文字列が表示されていない」状態です。まだ項目が追加されていないのに「項目追加しました」とのメッセージが出てしまうのも変なので、リスト表示後にコメント表示するようにしました。。

アプリ実例

「先入先出の入出庫管理システム」
「DVD等の内容・保管場所等管理システム」


項目追加が可能なコンボボックスリスト（its-018.xlsm）
セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始）
解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。