顧客管理カルテの内容
ココがポイント
シンプルに顧客のラケット情報をデータベース化したい！
というだけです。
自分が使用する訳ではないので仕様が分からないまま画面イメージだけで作成してみました。
とりあえずプロトタイプなので、マスタは、顧客マスタだけというシンプルな内容になっています。
つまり、顧客マスタに関連付けられたラケットの管理データが抽出できれば良い事になりいます。
とは言え、データベースとして運用するには、登録、変更、削除という基本機能が必要になります。
また、顧客マスタに関連した管理データを抽出するクエリ、もしくは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にした方がスマートなのでしょうけどめんどくさかったので、変更は直接編集で対応しました。
（作業１）顧客の抽出
顧客管理カルテを使用するためには、最初に「顧客マスタ」にて追加します。
そして、次に、カルテの情報を追加して行く訳ですが、その前に、対象の顧客を抽出しなければなりません。
名前や、電話番号の一部を入れて、「検索」ボタンを押す事で抽出させるようにしました。
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
検索した時に、同性同名などの重複レコードがある場合があるので、確実に１名に絞り込めるように工夫をしました。
もっと親切に作り込むなら、重複リストがでて選択できるような仕組みにした方が良いのかもしれませんが、プロトタイプということでシンプルにメッセージが出るだけにしました。
（作業２）種目からカルテ抽出
顧客名が抽出できたら、その顧客の種目を選択すます。
その選択と同時に、カルテを抽出できるように、「管理データ」フォームのレコードソースをクエリにしました。
つまり、種目を選択すると同時に、管理カルテの内容が抽出される事になります。
VBAを使って、レコードソースを設定する方法もありますが、このレベルならクエリで十分でしょうね。
https://pctips.jp/pc-soft/access-combo-source/
（作業３）カルテ登録
種目を選択すると、カルテが抽出されますが、追加する場合のフォーム「カルテ登録」を準備しました。
各フィールドは非連結テキストボックスとなっており、「登録」ボタンをクリックすることでレコードに追加されます。
このフォームには、可視（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
つまり、顧客を選択してない状態にしますので、当然、何も表示されなくなります。
こんな感じで、簡単に顧客管理カルテを作成してみました。
プロトタイプなので、あとは使う人の要望がある場合は修正していきます。
できるだけ、マウスだけでデータを入力できるような仕組みにした方が良いかと思います。