データベース

【Access】顧客管理カルテを作成（VBAで追加、削除など）

Access　顧客管理カルテ

顧客管理カルテの内容

ココがポイント

シンプルに顧客のラケット情報をデータベース化したい！

というだけです。

自分が使用する訳ではないので仕様が分からないまま画面イメージだけで作成してみました。

とりあえずプロトタイプなので、マスタは、顧客マスタだけというシンプルな内容になっています。

つまり、顧客マスタに関連付けられたラケットの管理データが抽出できれば良い事になりいます。

とは言え、データベースとして運用するには、登録、変更、削除という基本機能が必要になります。

また、顧客マスタに関連した管理データを抽出するクエリ、もしくはVBAが必要となります。

 

テーブル内容

Access　顧客管理カルテ

とりあえず、「顧客マスタ」と「管理データ」というテーブルを準備しました。

サンプルとして、デモデータも入力しておきました。

そして、要なのが、リレーションシップになります。

Access　顧客管理カルテ

顧客マスタのオートナンバー（ユニークキー）と、管理データのRSIDをリレーションさせました。

このリレーションにより、顧客を消去したときに、関連した管理データも消去されることになります。

 

顧客マスタ登録

テーブルをそのままフォームにして作業をするのも良いのですが、人的ミスが発生しやすくなるので、それぞれの処理をボタンを設置します。

Access　顧客管理カルテ

顧客マスタをフォームにして、「追加」をOFFにしてレコードを追加できないようにしました。

レコードの追加は、非連結のテキストボックスの値から、VBAで追加処理をしました。

Private Sub new_entry_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

If IsNull(input_no) Then
MsgBox ("顧客番号が入力されていません。")
Exit Sub
End If

If IsNull(input_name) Then
MsgBox ("名前が入力されていません。")
Exit Sub
End If

If IsNull(input_tel) Then
MsgBox ("電話番号が入力されていません。")
Exit Sub
End If

If MsgBox("追加しますか？ yes/no", vbYesNo, "データ追加確認") = vbYes Then

    On Error GoTo ErrRtn
    
    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset
    rs.Open "顧客マスタ", cn, adOpenKeyset, adLockOptimistic
    
    ' トランザクションの開始
    cn.BeginTrans
    
    rs.AddNew
    
    rs!NO = input_no
    rs!氏名 = input_name
    rs!電話番号 = input_tel
    
    rs.Update
    MsgBox ("追加しました。")
    
    ' トランザクションの保存
    cn.CommitTrans
    
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing

Else

    MsgBox ("追加しませんでした。")
    Exit Sub

End If

ExitErrRtn:
    input_no = Null
    input_name = Null
    input_tel = Null
    DoCmd.ShowAllRecords
    Exit Sub

ErrRtn:
    MsgBox "エラー： " & Err.Description
    'BeginTransの時点まで戻り、変更をキャンセルする
    
    cn.RollbackTrans
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

レコードの削除もボタンを設置することで、削除前にメッセージを出現される事ができます。

Private Sub del_btn_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

On Error GoTo ErrRtn

If MsgBox("実行しますか？ yes/no", vbYesNo, "削除確認") = vbYes Then

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset
    
    cn.BeginTrans
    
    rs.Open "顧客マスタ", cn, adOpenStatic, adLockOptimistic
    
    ' Debug.Print Me.call_ID
    
    rs.Find "ID = " & input_ID
    
    rs.Delete
    
    cn.CommitTrans
    
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing

Else

    MsgBox "削除しませんでした。"

Exit Sub
End If

ExitErrRtn:

DoCmd.ShowAllRecords
Exit Sub

ErrRtn:
MsgBox "エラー： " & Err.Description
cn.RollbackTrans
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub

こんな感じでVBAをボタンに設置しました。

本当は、変更修正作業もVBAにした方がスマートなのでしょうけどめんどくさかったので、変更は直接編集で対応しました。

 

（作業１）顧客の抽出

顧客管理カルテを使用するためには、最初に「顧客マスタ」にて追加します。

そして、次に、カルテの情報を追加して行く訳ですが、その前に、対象の顧客を抽出しなければなりません。

Access　顧客管理カルテ

名前や、電話番号の一部を入れて、「検索」ボタンを押す事で抽出させるようにしました。

Private Sub 検索_Click()
'変数を定義
Dim cnn As ADODB.Connection
Dim rs1 As ADODB.Recordset

'変数にADOオブジェクトを代入
Set cnn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient

'レコードセットを取得
rs1.Open "顧客マスタ", cnn, adOpenKeyset, adLockOptimistic

    If IsNull(s_name) Then
            rs1.Filter = "電話番号 Like '*" & Me!s_tel & "*'"
        Else
            rs1.Filter = "氏名 Like '*" & Me!s_name & "*'"
    End If

'対象レコードが無い場合
If rs1.RecordCount = 0 Then
    MsgBox ("条件に一致するデータは存在しませんでした。")
    s_name = Null
    '処理終了
    Exit Sub

ElseIf rs1.RecordCount = 1 Then
    s_ID = rs1!ID
    s_name = rs1!氏名
    s_tel = rs1!電話番号

'対象レコードがある場合
Else

    MsgBox ("複数の顧客データが存在します。電話番号で検索してください。")

End If

'終了処理
rs1.Close: Set rs1 = Nothing
cnn.Close: Set cnn = Nothing

End Sub

検索した時に、同性同名などの重複レコードがある場合があるので、確実に１名に絞り込めるように工夫をしました。

もっと親切に作り込むなら、重複リストがでて選択できるような仕組みにした方が良いのかもしれませんが、プロトタイプということでシンプルにメッセージが出るだけにしました。

 

（作業２）種目からカルテ抽出

顧客名が抽出できたら、その顧客の種目を選択すます。

その選択と同時に、カルテを抽出できるように、「管理データ」フォームのレコードソースをクエリにしました。

Access　顧客管理カルテ

つまり、種目を選択すると同時に、管理カルテの内容が抽出される事になります。

VBAを使って、レコードソースを設定する方法もありますが、このレベルならクエリで十分でしょうね。

【Access】コンボボックスから値を選択して抽出されたデータをレコードソースにする方法

 

（作業３）カルテ登録

種目を選択すると、カルテが抽出されますが、追加する場合のフォーム「カルテ登録」を準備しました。

各フィールドは非連結テキストボックスとなっており、「登録」ボタンをクリックすることでレコードに追加されます。

Access　顧客管理カルテ

このフォームには、可視（OFF）にして、「edit_ID」と「edit_Event」がフォームを開くときに、「管理データ」の方からコピーされる仕組みになっています。

つまり、リレーションする「ID」と「競技」が含まれてないと顧客マスタとリレーションができないので必須になります。

「登録」ボタンをクリックした時のVBAが下記になります。

Private Sub カルテ登録_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

If IsNull(edit_日付) Then
MsgBox ("日付が入力されていません。")
Exit Sub
End If

If MsgBox("追加しますか？ yes/no", vbYesNo, "データ追加確認") = vbYes Then

On Error GoTo ErrRtn

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset
    rs.Open "管理データ", cn, adOpenKeyset, adLockOptimistic
    
    ' トランザクションの開始
    cn.BeginTrans
    
    rs.AddNew
    
    rs!RSID = edit_ID
    rs!日付 = edit_日付
    rs!競技 = edit_Event
    rs!ガットメーカー = edit_ガットメーカー
    rs!ガット内容 = edit_ガット内容
    rs!縦横の張力 = edit_縦横の張力
    rs!ラケット名 = edit_ラケット名
    rs!備考 = edit_備考
    
    rs.Update
    MsgBox ("追加しました。")
    
    ' トランザクションの保存
    cn.CommitTrans
    
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing

Else

    MsgBox ("追加しませんでした。")
    Exit Sub

End If

ExitErrRtn:
    DoCmd.Close acForm, "カルテ登録", acSaveNo
    DoCmd.ShowAllRecords
    Exit Sub

ErrRtn:
    MsgBox "エラー： " & Err.Description
    'BeginTransの時点まで戻り、変更をキャンセルする
    
    cn.RollbackTrans
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Subか

カルテ登録すると、登録フォームは消えて、管理データが、DoCmd.ShowAllRecordsによって再クエリされて画面が更新され、追加されたレコードが表示されます。

削除の方は、管理データのレコードごとに削除ボタンを設置しました。

Private Sub カルテ削除_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

On Error GoTo ErrRtn

If MsgBox("実行しますか？ yes/no", vbYesNo, "削除確認") = vbYes Then

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset
    
    cn.BeginTrans
    
    rs.Open "管理データ", cn, adOpenStatic, adLockOptimistic
    
    rs.Find "ID = " & key_ID
    
    rs.Delete
    
    cn.CommitTrans
    
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing

Else

    MsgBox "削除しませんでした。"

Exit Sub
End If

ExitErrRtn:

DoCmd.ShowAllRecords
Exit Sub

ErrRtn:
MsgBox "エラー： " & Err.Description
cn.RollbackTrans
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub

修正変更の場合は、顧客マスタの様に、直接編集できるようにしました。

これも、人的ミスを減らすなら、修正変更のフォーム画面が出てきてボタンをクリックすることで実行された方がよいのですが、プロトタイプなので省略しました。

 

動作確認して完成

あとは、テストになりますが、顧客を追加したり、削除してみたり、修正したりの基本操作をしてみました。

カルテデータの方も、追加したり削除したり修正して動作確認をしました。

Access　顧客管理カルテ

顧客を抽出したら、種目を選択すると、カルテデータも抽出されました。

そして、データがない場合は何も表示されません。

Access　顧客管理カルテ

顧客管理していて、対象外のデータが表示されないということは重要ですね。

何かの拍子に他の方のデータが出てしまったら問題になりますからね。

ちなみに、「クリア」ボタンは、顧客名と種目をNULLにします。

Private Sub コマンド25_Click()
    s_ID = Null
    s_name = Null
    s_tel = Null
    s_Event = Null
    
    DoCmd.ShowAllRecords

End Sub

つまり、顧客を選択してない状態にしますので、当然、何も表示されなくなります。

 

こんな感じで、簡単に顧客管理カルテを作成してみました。

プロトタイプなので、あとは使う人の要望がある場合は修正していきます。

できるだけ、マウスだけでデータを入力できるような仕組みにした方が良いかと思います。

 

-データベース
-, , , , , , , ,

Translate »

© 2025 PCTips