[ ユーザーフォーム_目次 ]

登録用フォーム

登録用フォームは、入力内容をチェックして、エラーがなければワークシートに入力内容を登録しています。

[ 目次 ]
  1. 画面を再確認
  2. 初期処理
  3. 採番ボタン　クリック時
  4. 登録ボタン　クリック時
  5. キャンセルボタン　クリック時



画面を再確認

登録1



初期処理

使用する各コンボボックスの値を設定しています。設定は標準モジュールで行います。 

Private Sub UserForm_Initialize()

    SetComboBox (Me)

End Sub
− Memo −
  1. 標準モジュールの SetComboBox には、引数としてフォーム自体を渡します。



採番ボタン　クリック時

ワークシートに保管してある最終ＩＤからＩＤを採番して表示し、最終ＩＤを更新します。 

Private Sub ButtonNumberID_Click()

    Worksheets("ID設定").Select
    Dim lastID As String
    lastID = Cells(2, 1).Value
    
    Dim newID As String
    Dim left1 As String
    Dim right4 As String
    
    left1 = Left(lastID, 1)
    right4 = Right(lastID, 4)
    
    right4 = WorksheetFunction.Text(Val(right4) + 1, "0000")
    newID = left1 & right4
    
    LabelID.Caption = newID
    Cells(2, 1).Value = newID
    
    ButtonNumberID.Enabled = False
    
End Sub
− Memo −
  1. ＩＤの頭に英文字を入れているので、わざわざ編集していますが、数字だけであれば、もっとシンプルになると思います。
  2. 一度採番したら、採番ボタンを押せないようにしています。



登録ボタン　クリック時

入力内容をチェックし、チェックを通過したら、ワークシートの最終行に値を登録しています。 

Private Sub ButtonAdd_Click()

    '入力チェック
    If InputIsInvalid Then
        Exit Sub
    End If
    
    'データを登録
    Worksheets("sheet1").Select
    Dim lastRow As Integer
    lastRow = Range("B1048576").End(xlUp).Row
    Cells(lastRow + 1, 1).Value = LabelID.Caption
    Cells(lastRow + 1, 2).Value = BoxName.Text
    Cells(lastRow + 1, 3).Value = BoxSex.Text
    Cells(lastRow + 1, 4).Value = DateOfBirth
    
    MsgBox LabelID.Caption & vbCrLf & BoxName.Text & vbCrLf & _
            "この会員を登録しました。", vbInformation + vbOKOnly, "確認"
    
    '入力項目をクリア
    LabelID.Caption = ""
    BoxName.Text = ""
    BoxSex.Value = ""
    BoxYear.Value = ""
    BoxMonth.Value = ""
    BoxDay.Value = ""

    '採番ボタンを使用可にする
    ButtonNumberID.Enabled = True
    ButtonNumberID.SetFocus
    
End Sub
----------------------------------------------------------------------

Private Function InputIsInvalid() As Boolean

    'IDチェック
    If LabelID.Caption = "" Then
        MsgBox "ID を採番してください", vbExclamation, "ID 採番エラー"
        InputIsInvalid = True
        Exit Function
    End If

    '名前チェック
    If BoxName.Text = "" Then
        MsgBox "名前を入力してください", vbExclamation, "名前 入力エラー"
        InputIsInvalid = True
        Exit Function
    End If

    '性別チェック
    If BoxSex.Text = "" Then
        MsgBox "性別を選択してください", vbExclamation, "性別 選択エラー"
        InputIsInvalid = True
        Exit Function
    End If

    '生年月日チェック
    DateOfBirth = BoxYear.Text & "/" & BoxMonth.Text & "/" & BoxDay.Text
    If Not (IsDate(DateOfBirth)) Then
        MsgBox "生年月日を確認してください", vbExclamation, "生年月日エラー"
        InputIsInvalid = True
        Exit Function
    End If

    InputIsInvalid = False
    
End Function
− Memo −
  1. すべてを１プロシージャに記述すると長いので、入力チェックを別プロシージャにしました。
  2. 生年月日については、日付妥当性チェックをしています。(2月31日も選択できるような緩い仕様のため)
  3. 登録後、入力項目をクリアします。フォームは閉じず、採番ボタンを使用可にして、連続入力に備えます。
  4. フォーカスを採番ボタンにセットします。



キャンセルボタン　クリック時

登録用フォームを閉じます。 

Private Sub ButtonCancel_Click()

    Unload Me

End Sub