第2回 フォームを使った顧客管理の作成 [検索ボタンの追加]

前回の「第1回 フォームを使った顧客管理の作成[初級編]」で作成した「顧客情報入力」フォームに「検索」ボタンを追加して、「顧客検索」画面表示→顧客選択→データ表示→修正登録が出来るよう機能追加する手順を紹介します。
koky011120.gif

koky011130.gif


＜機能追加手順＞
●フォームを使った顧客管理の作成[初級編] で作成したファイルを開いて「Visual Basic Editor」を起動し、メニューバー「挿入→標準モジュール」で標準モジュールを追加します。
koky011010.gif

追加した標準モジュールへ「顧客情報入力」フォームと「顧客検索」フォーム間でデータを受け渡しを行うための変数の宣言を記述します。
koky011020.gif

Public rtnNo As Long      '← 長整数型の変数の宣言


●メニューバー「挿入→ユーザーフォーム」で新規フォームを追加します。
koky011030.gif

顧客名のラベルとテキストボックスを追加し、テキストボックスの「オブジェクト名」プロパティに名前(txt顧客名)を設定します。
koky011040.gif

リストボックスを追加し、リストボックスの「オブジェクト名」プロパティに名前(lst顧客リスト)を設定します。
koky011050.gif

リストボックスの「ColumnCount」プロパティ(列数)に「2」を設定し、「ColumnWidths」プロパティ(列幅)に「20 ; 200」を設定します。
koky011060.gif

フォームの処理を記述します。
koky011070.gif

Private Sub UserForm_Initialize()      '← フォームを表示した時の処理追加
    rtnNo = 0      '← フォーム間のデータ受け渡し用変更の初期化
    Call SetListBox      '← リストボックスに表示する処理を実行(下部に処理記述)
End Sub

Private Sub txt顧客名_Change()      '← 検索する顧客名を入力した時の処理追加
    Call SetListBox      '← リストボックスに表示する処理を実行(下部に処理記述)
End Sub

Private Sub lst顧客リスト_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
     'リストボックスから顧客名をダブルクリック選択した時の処理追加
    rtnNo = Me.lst顧客リスト.Text      '← ダブルクリックされた顧客名の行番号を渡す
    Unload Me      '← フォームを閉じる
End Sub

Private Sub SetListBox()      '← リストボックスに表示する処理追加
    Dim wRow As Long
    Dim wLstRow As Long

    Me.lst顧客リスト.Clear      '← リストボックスを初期化
    wLstRow = 0
    For wRow = 2 To Worksheets("顧客情報").Range("A1").CurrentRegion.Rows.Count
        If Me.txt顧客名 = "" Then
             '検索する顧客名が入力されていない場合は、
             '「顧客情報」シートの2行目～最終行の行番号と顧客名をリストボックスにセット
            Me.lst顧客リスト.AddItem ""
            Me.lst顧客リスト.List(wLstRow, 0) = wRow
            Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
            wLstRow = wLstRow + 1
        Else
            If InStr(1, Worksheets("顧客情報").Cells(wRow, 2), Me.txt顧客名, vbTextCompare) > 0 Then
                 '検索する顧客名が一部一致した場合、行番号と顧客名をリストボックスにセット
                Me.lst顧客リスト.AddItem ""
                Me.lst顧客リスト.List(wLstRow, 0) = wRow
                Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
                wLstRow = wLstRow + 1
            End If
        End If
    Next
End Sub


●作成したフォームの「オブジェクト名」プロパティに名前(frm顧客検索)を付けて、フォームのタイトルバーに表示する名称(顧客検索)を「Caption」プロパティに設定します。
koky011080.gif

●初級編で作成した「frm顧客情報入力」フォームを開き、行番号用のラベルを追加し、ラベルの「オブジェクト名」プロパティに名前(lbl行番号)を設定します。
koky011090.gif

検索用のコマンドボタンを追加し、「オブジェクト名」プロパティに名前(cmd検索)を付けて、ボタンに表示する名称(検索)を「Caption」プロパティに設定します。
koky011100.gif

「frm顧客情報入力」フォームの処理を追加・変更します。
koky011110.gif

Private Sub UserForm_Initialize()      '← フォームを表示した時の処理追加
     '行番号ラベルに最終行＋1をセット
    Me.lbl行番号.Caption = Worksheets("顧客情報").Range("A1").CurrentRegion.Rows.Count + 1
End Sub

Private Sub cmd検索_Click()      '← 検索ボタン押下時の処理追加
    frm顧客検索.Show vbModal      '← 顧客検索フォームを表示する
    If rtnNo > 1 Then
         '顧客検索フォームから渡された行番号のデータをセットする
        With Worksheets("顧客情報")
            Me.lbl行番号.Caption = rtnNo
            Me.txt顧客番号 = .Cells(rtnNo, 1)
            Me.txt顧客名 = .Cells(rtnNo, 2)
            Me.txt郵便番号 = .Cells(rtnNo, 3)
            Me.txt住所 = .Cells(rtnNo, 4)
            Me.txt電話番号 = .Cells(rtnNo, 5)
            Me.txt備考 = .Cells(rtnNo, 6)
        End With
    End If
End Sub

Private Sub cmd登録_Click()      '← 登録ボタン押下時の処理
    Dim wRow As Long

    If Me.txt顧客番号 = "" Then
        MsgBox "顧客番号を入力してください。", vbExclamation + vbOKOnly, "入力エラー"
        Exit Sub
    End If

    If Me.txt顧客名 = "" Then
        MsgBox "顧客名を入力してください。", vbExclamation + vbOKOnly, "入力エラー"
        Exit Sub
    End If

     'フォーム上の各データをシートへ送る
    With Worksheets("顧客情報")
        wRow = Me.lbl行番号.Caption
        .Cells(wRow, 1) = Me.txt顧客番号
        .Cells(wRow, 2) = Me.txt顧客名
        .Cells(wRow, 3) = Me.txt郵便番号
        .Cells(wRow, 4) = Me.txt住所
        .Cells(wRow, 5) = Me.txt電話番号
        .Cells(wRow, 6) = Me.txt備考
    End With

    Unload Me
End Sub


＜完成＞
koky011120.gif

koky011130.gif



次回は、今回作成したフォームに [ |< ] [ < ] [ > ] [ >| ] [新規]ボタンを追加して、「顧客情報入力」画面内で顧客データの「先頭へ移動」「前へ移動」「次へ移動」「最終へ移動」「新規へ移動」が出来るよう機能追加する手順を紹介します。
第3回 フォームを使った顧客管理の作成 [移動ボタンの追加]