顧客管理カルテの内容
ココがポイント
シンプルに顧客のラケット情報をデータベース化したい!
というだけです。
自分が使用する訳ではないので仕様が分からないまま画面イメージだけで作成してみました。
とりあえずプロトタイプなので、マスタは、顧客マスタだけというシンプルな内容になっています。
つまり、顧客マスタに関連付けられたラケットの管理データが抽出できれば良い事になりいます。
とは言え、データベースとして運用するには、登録、変更、削除という基本機能が必要になります。
また、顧客マスタに関連した管理データを抽出するクエリ、もしくはVBAが必要となります。
テーブル内容
とりあえず、「顧客マスタ」と「管理データ」というテーブルを準備しました。
サンプルとして、デモデータも入力しておきました。
そして、要なのが、リレーションシップになります。
顧客マスタのオートナンバー(ユニークキー)と、管理データのRSIDをリレーションさせました。
このリレーションにより、顧客を消去したときに、関連した管理データも消去されることになります。
顧客マスタ登録
テーブルをそのままフォームにして作業をするのも良いのですが、人的ミスが発生しやすくなるので、それぞれの処理をボタンを設置します。
顧客マスタをフォームにして、「追加」を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にした方がスマートなのでしょうけどめんどくさかったので、変更は直接編集で対応しました。
(作業1)顧客の抽出
顧客管理カルテを使用するためには、最初に「顧客マスタ」にて追加します。
そして、次に、カルテの情報を追加して行く訳ですが、その前に、対象の顧客を抽出しなければなりません。
名前や、電話番号の一部を入れて、「検索」ボタンを押す事で抽出させるようにしました。
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
検索した時に、同性同名などの重複レコードがある場合があるので、確実に1名に絞り込めるように工夫をしました。
もっと親切に作り込むなら、重複リストがでて選択できるような仕組みにした方が良いのかもしれませんが、プロトタイプということでシンプルにメッセージが出るだけにしました。
(作業2)種目からカルテ抽出
顧客名が抽出できたら、その顧客の種目を選択すます。
その選択と同時に、カルテを抽出できるように、「管理データ」フォームのレコードソースをクエリにしました。
つまり、種目を選択すると同時に、管理カルテの内容が抽出される事になります。
VBAを使って、レコードソースを設定する方法もありますが、このレベルならクエリで十分でしょうね。
(作業3)カルテ登録
種目を選択すると、カルテが抽出されますが、追加する場合のフォーム「カルテ登録」を準備しました。
各フィールドは非連結テキストボックスとなっており、「登録」ボタンをクリックすることでレコードに追加されます。
このフォームには、可視(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
修正変更の場合は、顧客マスタの様に、直接編集できるようにしました。
これも、人的ミスを減らすなら、修正変更のフォーム画面が出てきてボタンをクリックすることで実行された方がよいのですが、プロトタイプなので省略しました。
動作確認して完成
あとは、テストになりますが、顧客を追加したり、削除してみたり、修正したりの基本操作をしてみました。
カルテデータの方も、追加したり削除したり修正して動作確認をしました。
顧客を抽出したら、種目を選択すると、カルテデータも抽出されました。
そして、データがない場合は何も表示されません。
顧客管理していて、対象外のデータが表示されないということは重要ですね。
何かの拍子に他の方のデータが出てしまったら問題になりますからね。
ちなみに、「クリア」ボタンは、顧客名と種目をNULLにします。
Private Sub コマンド25_Click() s_ID = Null s_name = Null s_tel = Null s_Event = Null DoCmd.ShowAllRecords End Sub
つまり、顧客を選択してない状態にしますので、当然、何も表示されなくなります。
こんな感じで、簡単に顧客管理カルテを作成してみました。
プロトタイプなので、あとは使う人の要望がある場合は修正していきます。
できるだけ、マウスだけでデータを入力できるような仕組みにした方が良いかと思います。