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

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


＜機能追加手順＞
●フォームを使った顧客管理の作成[検索ボタンの追加] で作成したファイルを開いて「Visual Basic Editor」を起動し、前回作成した「frm顧客情報入力」フォームを開き、フォームに [ |< ] [ < ] [ > ] [ >| ] [新規]ボタン追加します。
koky012010.gif
[ |< ]･･･プロパティ「オブジェクト名：cmd先頭移動」「Caption：|<」を設定。
[ < ]･･･プロパティ「オブジェクト名：cmd前移動」「Caption：<」を設定。
[ > ]･･･プロパティ「オブジェクト名：cmd次移動」「Caption：>」を設定。
[ >| ]･･･プロパティ「オブジェクト名：cmd最終移動」「Caption：>|」を設定。
[新規]･･･プロパティ「オブジェクト名：cmd新規」「Caption：新規」を設定。


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

Private Sub UserForm_Initialize()
    Me.lbl行番号.Caption = Worksheets("顧客情報").Range("A1").CurrentRegion.Rows.Count + 1
End Sub

Private Sub cmd先頭移動_Click()      '← [ |< ]ボタンを押下した時の処理追加
    Call DspDataSet(2)      '← 顧客情報シートの先頭(2行目)のデータを表示(下部に処理記述)
End Sub

Private Sub cmd前移動_Click()      '← [ < ]ボタンを押下した時の処理追加
    If Me.lbl行番号 > 1 Then
         '先頭行より後なら1行前のデータを表示(下部に処理記述)
        Call DspDataSet(Me.lbl行番号 - 1)
    Else
         '先頭行以前なら先頭データを表示(下部に処理記述)
        Call DspDataSet(1)
    End If
End Sub

Private Sub cmd次移動_Click()      '← [ > ]ボタンを押下した時の処理追加
    Dim wMaxRow As Long

    wMaxRow = Worksheets("顧客情報").Range("A1").CurrentRegion.Rows.Count      '← 最終行番号

    If Me.lbl行番号 < wMaxRow Then
         '最終行より前なら1行次のデータを表示(下部に処理記述)
        Call DspDataSet(Me.lbl行番号 + 1)
    Else
         '最終行以降なら最終データを表示(下部に処理記述)
        Call DspDataSet(wMaxRow)
    End If
End Sub

Private Sub cmd最終移動_Click()      '← [ >| ]ボタンを押下した時の処理追加
    Dim wMaxRow As Long

    wMaxRow = Worksheets("顧客情報").Range("A1").CurrentRegion.Rows.Count      '← 最終行番号
    Call DspDataSet(wMaxRow)      '← 顧客情報シートの最終行のデータを表示(下部に処理記述)
End Sub

Private Sub cmd新規_Click()      '← [新規]ボタンを押下した時の処理追加
    Call DspDataSet(0)      '← 新規のデータを表示(下部に処理記述)
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

    MsgBox "登録しました。", vbInformation + vbOKOnly, "Information"      '← 登録メッセージ表示
End Sub

Private Sub DspDataSet(prmNo)      '← フォームへデータを表示する処理追加
    With Worksheets("顧客情報")
        If prmNo > 1 Then
             '2行目以降なら、その行のデータをフォームへセット
            Me.lbl行番号.Caption = prmNo
            Me.txt顧客番号 = .Cells(prmNo, 1)
            Me.txt顧客名 = .Cells(prmNo, 2)
            Me.txt郵便番号 = .Cells(prmNo, 3)
            Me.txt住所 = .Cells(prmNo, 4)
            Me.txt電話番号 = .Cells(prmNo, 5)
            Me.txt備考 = .Cells(prmNo, 6)
        Else
             '行番号がなければ、各項目をクリアして行番号に最終行＋1をセット
            Me.lbl行番号.Caption = .Range("A1").CurrentRegion.Rows.Count + 1
            Me.txt顧客番号 = ""
            Me.txt顧客名 = ""
            Me.txt郵便番号 = ""
            Me.txt住所 = ""
            Me.txt電話番号 = ""
            Me.txt備考 = ""
        End If
    End With
    Me.txt顧客番号.SetFocus      '← 「顧客番号」項目にカーソルを移動
End Sub


＜完成＞
koky012030.gif



次回は、今回作成したフォームに「フリガナ」項目を追加し、顧客名を入力した際にフリガナが自動初期表示されるよう機能追加する手順を紹介します。
第4回 フォームを使った顧客管理の作成 [名前定義の利用]