第6回 フォームを使った顧客管理の作成 [生年月日の追加]

今回は、前回までに作成した「顧客情報入力」フォームに「生年月日」項目と年齢欄を追加し、年齢を自動計算表示するよう機能追加する手順を紹介します。
koky016080.gif


＜機能追加手順＞
●第5回 フォームを使った顧客管理の作成 [顧客分類の追加] で作成したファイルを開き、
「顧客情報」シートのG列に生年月日用の列を挿入します。
koky016010.gif

セル「G1」を選択した状態で「名前の定義」ウィンドウを表示して、名前「生年月日列」を追加します。(挿入したG列以降の名前定義のセル位置は自動変更されます)
koky016020.gif

●「Visual Basic Editor」を起動し、「frm顧客情報入力」フォームに生年月日用のラベルとテキストボックス(オブジェクト名：txt生年月日)と年齢用のラベル(オブジェクト名：lbl年齢)を追加します。
koky016050.gif

入力順番の変更は、フォーム上を右クリックしてショートカットメニューの「タブオーダー」から設定します。
koky016060.gif

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


Private Sub txt生年月日_AfterUpdate()    '←生年月日を入力した時の処理追加
    If IsDate(Me.txt生年月日) = True Then
        Me.txt生年月日 = Format(Me.txt生年月日, "ge/mm/dd")    '←生年月日を和暦表示
        Me.lbl年齢.Caption = CmpNenrei(Me.txt生年月日)    '←年齢を計算表示(下部に処理記述)
    Else
        Me.txt生年月日 = ""
        Me.lbl年齢.Caption = ""
    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, .Range("顧客番号列").Column) = Me.txt顧客番号
        .Cells(wRow, .Range("顧客名列").Column) = Me.txt顧客名
        .Cells(wRow, .Range("フリガナ列").Column) = Me.txtフリガナ
        .Cells(wRow, .Range("郵便番号列").Column) = Me.txt郵便番号
        .Cells(wRow, .Range("住所列").Column) = Me.txt住所
        .Cells(wRow, .Range("電話番号列").Column) = Me.txt電話番号
        .Cells(wRow, .Range("生年月日列").Column) = Me.txt生年月日
        .Cells(wRow, .Range("顧客分類列").Column) = Me.cmb顧客分類
        .Cells(wRow, .Range("備考列").Column) = Me.txt備考
    End With

    MsgBox "登録しました。", vbInformation + vbOKOnly, "Information"
End Sub

Private Sub DspDataSet(prmNo)
    With Worksheets("顧客情報")
        If prmNo > 1 Then
            Me.lbl行番号.Caption = prmNo
            Me.txt顧客番号 = .Cells(prmNo, .Range("顧客番号列").Column)
            Me.txt顧客名 = .Cells(prmNo, .Range("顧客名列").Column)
            Me.txtフリガナ = .Cells(prmNo, .Range("フリガナ列").Column)
            Me.txt郵便番号 = .Cells(prmNo, .Range("郵便番号列").Column)
            Me.txt住所 = .Cells(prmNo, .Range("住所列").Column)
            Me.txt電話番号 = .Cells(prmNo, .Range("電話番号列").Column)
            Me.txt生年月日 = Format(.Cells(prmNo, .Range("生年月日列").Column), "ge/mm/dd")
            Me.lbl年齢.Caption = CmpNenrei(Me.txt生年月日)
            Me.cmb顧客分類 = .Cells(prmNo, .Range("顧客分類列").Column)
            Me.txt備考 = .Cells(prmNo, .Range("備考列").Column)
        Else
            Me.lbl行番号.Caption = .Range("A1").CurrentRegion.Rows.Count + 1
            Me.txt顧客番号 = ""
            Me.txt顧客名 = ""
            Me.txtフリガナ = ""
            Me.txt郵便番号 = ""
            Me.txt住所 = ""
            Me.txt電話番号 = ""
            Me.txt生年月日 = ""
            Me.lbl年齢.Caption = ""
            Me.cmb顧客分類 = ""
            Me.txt備考 = ""
        End If
    End With
    Me.txt顧客番号.SetFocus
End Sub

Private Function CmpNenrei(prmDate As Variant) As Variant    '←年齢を計算する処理
    Dim wNenrei As Variant
    
    If IsDate(prmDate) = False Then
        wNenrei = ""
        Exit Function
    End If
    
    wNenrei = Year(Date) - Year(prmDate)    '←今日の年から生年月日の西暦年の差を計算
    If Format(Date, "mmdd") < Format(prmDate, "mmdd") Then    '←今年の誕生日は過ぎたか判定
        wNenrei = wNenrei - 1    '←今年の誕生日がまだなら１差し引く
    End If
    CmpNenrei = CInt(wNenrei)
End Function



＜完成＞
「顧客情報入力」フォームへ生年月日項目と年齢欄が追加され、年齢が自動計算表示されるようになりました。
koky016080.gif