「栄養計算ソフトにユーザーフォームを導入しよう」の連載第7回です。
以下の記事の続きになります。
前回は,コードを見直し,読みやすく・メンテナンスのしやすいように改善していきました。今回は,検索から食品を入力するためのフォームを作成していきたいと思います。
ではいきましょう。
コントロールを配置しよう
①フォームにコントロールを配置しよう
まずは,フォーム:「食品の入力|検索から」に,コントロールを配置していきます。以下のようにコントロールを配置してください
②コントロールにオブジェクト名とCaptionを設定しよう
それぞれのコントロールにオブジェクト名とCaptionを追加していきます。以下の表に従って行ってください。
オブジェクト名 | Caption | |
---|---|---|
①テキストボックス | txtSerchBox | |
②コマンドボタン | btnSerch | 検索する |
③ラベル | lblMsg | (空白にする) |
④リストボックス | lstFood | |
⑤コマンドボタン | btnAdd | 追加する |
では,それぞれのコントロールの役割を説明します。
- テキストボックスは,食品を検索するためのテキストを入力するためのものです。
- コマンドボタンは,①に入力されたテキストをもとに,検索を実行するためのものです。
- ラベルは,検索の結果(○件見つかったなど)を表示するためのものです。
- リストボックスは,検索の結果,見つかった食品を表示するためのものです。
- コマンドボタンは,④で選択した食品をシートに追加するためのものです。
検索ボタンを押した際の処理を記述しよう
では,いよいよ検索ボタンを押した際の処理を記述していきます。
検索ボタンをクリックして,検索ボタンを押した際に実行されるプロシージャを表示させましょう。
以下のコードを記述してください。
Private Sub btnSerch_Click() lstFood.Clear Dim serchWord As String serchWord = txtSerchBox.Text With Worksheets(WSNAME_MAIN) Dim i As Long, mainLastRow As Long mainLastRow = .Cells(Rows.Count, 1).End(xlUp).Row For i = MAIN_START_ROW To mainLastRow If InStr(1, .Cells(i, MAIN_FOODNAME_CLM), serchWord) >= 1 Then lstFood.AddItem (Format(.Cells(i, MAIM_FOODNUM_CLM).Value, "00000") & " " & .Cells(i, MAIN_FOODNAME_CLM).Value) End If Next i End With If lstFood.ListCount = 0 Then lblMsg.Caption = "見つかりませんでした" Else lblMsg.Caption = lstFood.ListCount & "件の食品が見つかりました" End If End Sub
実際にフォームを開き,リストボックスに食品が追加されること,ラベルにメッセージが表示されることを確認してください。
コードの解説
では,コードの解説をしていきます。
Dim serchWord As String serchWord = txtSerchBox.Text
ここでは,serchWordを検索ボックスのテキストを格納するための変数としています。検索ボックスのテキストは,テキストボックスのTextプロパティから取得できます。
For i = MAIN_START_ROW To mainLastRow If InStr(1, .Cells(i, MAIN_FOODNAME_CLM), serchWord) >= 1 Then lstFood.AddItem (Format(.Cells(i, MAIM_FOODNUM_CLM).Value, "00000") & " " & .Cells(i, MAIN_FOODNAME_CLM).Value) End If Next i
ここでは,本表の食品一覧に対して,検索ワードを含むものをリストボックスに追加しています。それには,InStr関数を活用しています。
IStr関数は,第2引数の文字列に対して,第3引数の文字列が何番目に含まれるかを返す関数です(第1引数は検索の開始位置なので1で構いません)。
つまり,本表の食品一覧に,検索ワードが含まれていれば,1以上の数字を,含まれていなければ0を返してくれます。1以上の数字が返された場合は,その食品に検索文字列が含まれるということになりますので,食品一覧に追加するための処理を行う,というわけなのです。
If lstFood.ListCount = 0 Then lblMsg.Caption = "見つかりませんでした" Else lblMsg.Caption = lstFood.ListCount & "件の食品が見つかりました" End If
この部分では,検索した結果,何件の食品が見つかったかを,lblMsgに表示させています。見つかったかどうかは,lstFoodに追加されている食品の数で判断しています。つまり,食品が追加されていない場合は見つからなかった旨のメッセージを表示し,見つかった場合は見つかった食品の数にメッセージを結合して表示させています。lslFoodに食品が追加されたかどうかは,LstFoodのプロパティ:ListCountで取得しました。
食品を追加する処理を記述しよう
先ほどまでの処理で,食品を検索し,それをリストボックスに追加することができました。では,食品を追加するための処理を記述していきましょう。
以前のコードをコピペでOK!
でも,それは以前に作成した,食品群一覧から食品を追加するのと同じコードで実装できます。なので,それをそのままコピペしてしまいましょう。コードは以下のようになっていましたね。
Private Sub btnAdd_Click() If ActiveCell.Row < NCS_START_ROW Then MsgBox "項目行より下を選択してください", vbCritical, "注意" Exit Sub End If Dim foodNum As String foodNum = Left(lstFood.Value, 5) '左から5文字が食品番号 Cells(ActiveCell.Row, NCS_FOODNUM_CLM).Value = foodNum ActiveCell.Offset(1, 0).Activate End Sub
実は,追加するためのボタンも,追加する食品を選ぶためのリストボックスもオブジェクト名は同じです。なので,特に変更する箇所もなく,コピペすることで簡単に処理を実装できます。
コードの全体を確認しておこう
これまでの連載で,かなり多くのコードを書いてきました。すこし複雑になってきましたので,ここで一度すべてのコードを公開しておきます。一度,確認しておいてください。
まずは食品群一覧から食品を入力するフォームに記述されているコードから。
Option Explicit Private Sub UserForm_Initialize() Dim i As Long For i = FG_START_INDEX To FG_END_INDEX Controls("OptionButton" & i).Caption = Worksheets(WSNAME_STG).Cells(i, 1).Value Next i End Sub Private Sub btnAdd_Click() If ActiveCell.Row < NCS_START_ROW Then MsgBox "項目行より下を選択してください", vbCritical, "注意" Exit Sub End If Dim foodNum As String foodNum = Left(lstFood.Value, 5) '左から5文字が食品番号 Cells(ActiveCell.Row, NCS_FOODNUM_CLM).Value = foodNum ActiveCell.Offset(1, 0).Activate End Sub Private Sub btnRef_Click() Dim i As Long Dim fg As Long For i = FG_START_INDEX To FG_END_INDEX If Controls("OptionButton" & i).Value = True Then fg = Val(Left(Controls("OptionButton" & i).Caption, 2)) 'オプションボタンの先頭2文字が食品番号。それを取得し数値に変更 例)01→1など End If Next i lstFood.Clear Dim mainLastRow As Long mainLastRow = Worksheets(WSNAME_MAIN).Cells(Rows.Count, 1).End(xlUp).Row For i = MAIN_START_ROW To mainLastRow With Worksheets(WSNAME_MAIN) If .Cells(i, 1).Value = fg Then lstFood.AddItem (Format(.Cells(i, MAIM_FOODNUM_CLM).Value, "00000") & " " & .Cells(i, MAIN_FOODNAME_CLM).Value) End If End With Next i End Sub
次は,検索から食品を入力するためのフォームにかかれているコードです。
Option Explicit Private Sub btnSerch_Click() lstFood.Clear Dim serchWord As String serchWord = txtSerchBox.Text With Worksheets(WSNAME_MAIN) Dim i As Long, mainLastRow As Long mainLastRow = .Cells(Rows.Count, 1).End(xlUp).Row For i = MAIN_START_ROW To mainLastRow If InStr(1, .Cells(i, MAIN_FOODNAME_CLM), serchWord) >= 1 Then lstFood.AddItem (Format(.Cells(i, MAIM_FOODNUM_CLM).Value, "00000") & " " & .Cells(i, MAIN_FOODNAME_CLM).Value) End If Next i End With If lstFood.ListCount = 0 Then lblMsg.Caption = "見つかりませんでした" Else lblMsg.Caption = lstFood.ListCount & "件の食品が見つかりました" End If End Sub Private Sub btnAdd_Click() If ActiveCell.Row < NCS_START_ROW Then MsgBox "項目行より下を選択してください", vbCritical, "注意" Exit Sub End If Dim foodNum As String foodNum = Left(lstFood.Value, 5) '左から5文字が食品番号 Cells(ActiveCell.Row, NCS_FOODNUM_CLM).Value = foodNum ActiveCell.Offset(1, 0).Activate End Sub
次に,標準モジュールのModule1に記述されているコードです。ここではPublic定数を宣言していましたね。
Public Const FG_START_INDEX As Long = 1 '食品群の開始番号 Public Const FG_END_INDEX As Long = 18 '食品群の終了番号 Public Const NCS_START_ROW As Long = 5 '栄養計算シートの開始行番号 Public Const NCS_FOODNUM_CLM As Long = 2 '栄養計算シートの食品番号の列番号 Public Const NCS_FOODNAME_CLM As Long = 3 '栄養計算シートの食品番号の列番号 Public Const MAIN_START_ROW As Long = 9 '本表シートの食品の開始行 Public Const MAIM_FOODGROUP_CLM As Long = 1 '本表シートの食品群の列番号 Public Const MAIM_FOODNUM_CLM As Long = 2 '本表シートの食品番号の列番号 Public Const MAIN_FOODNAME_CLM As Long = 4 '本表シートの食品名の列番号 Public Const WSNAME_MAIN As String = "本表" '本表のシート名 Public Const WSNAME_SUB As String = "別表" '別表のシート名 Public Const WSNAME_NCS As String = "栄養計算シート" '栄養計算シートのシート名 Public Const WSNAME_STG As String = "設定" '設定シートのシート名
最後に「栄養計算シート」のシートモジュールです:
Private Sub CommandButton1_Click()
frmFoodGroup.show (vbModeless)
End Sub
Private Sub CommandButton2_Click()
frmSearch.show (vbModeless)
End Sub
しっかりと入力できていましたか?もう一度,確認してみてくださいね。
まとめ
今回は検索から食品を入力するための処理を実装しました。次回は,細かいエラー処理などを実装して,一応の完成としたいと思います。