動きとしては、「個人リスト」と「家族リスト」にチェックされているときは、セレクタをクリックした人の情報を
表示するようにします。「家族登録」にチェックされている場合は、現在表示されている人をセレクタをクリックした
人の家族として登録します。
個人リストや家族関連の情報を 表示するサブフォームのプログラムを作りましょう。
次がサブフォームに表示する［個人リスト］、［家族登録］、［家族リスト］を選択したときのものです。
01:'概要：サブフォームに選択された情報を表示する
02:Private Sub grpリストタイプ_AfterUpdate()
03: If Me.grpリストタイプ = 1 Then
04: '個人リスト
05: Me.grp選択.Enabled = True
06: If IsNull(Me.txt姓カナ) Then Exit Sub
07: Me.grp選択 = fncGetHeader(Me.txt姓カナ)
08: grp選択_AfterUpdate
09: Else
10: SetSubFamily
11: End If
12:End Sub
［個人リスト］を選択した時は、五十音で絞り込みすることが出来るようにするため5行目で“．Enabled=True”にしています。
8行目は、五十音で絞込みをするために五十音をクリックしたときのイベントプロシージャを呼び出しています。中身は、次のようになっています。
01:'概要：五十音で絞込みを行う。
02:Private Sub grp選択_AfterUpdate()
03: Dim strCritria As String
04: Dim strSql As String
05: Select Case Me.grp選択
06: 'あ行
07: Case 1
08: strCritria = "WHERE (Asc([姓カナ]) Between 177 And 181) AND Not 姓カナ Is Null"
09: 'か行
10: Case 2
11: strCritria = "WHERE (Asc([姓カナ]) Between 182 And 186) AND Not 姓カナ Is Null"
12: 'さ行
13: Case 3
14: strCritria = "WHERE (Asc([姓カナ]) Between 187 And 191) AND Not 姓カナ Is Null"
15: 'た行
16: Case 4
17: strCritria = "WHERE (Asc([姓カナ]) Between 192 And 196) AND Not 姓カナ Is Null"
18: 'な行
19: Case 5
20: strCritria = "WHERE (Asc([姓カナ]) Between 197 And 201) AND Not 姓カナ Is Null"
21: 'は行
22: Case 6
23: strCritria = "WHERE (Asc([姓カナ]) Between 202 And 206) AND Not 姓カナ Is Null"
24: 'ま行
25: Case 7
26: strCritria = "WHERE (Asc([姓カナ]) Between 207 And 211) AND Not 姓カナ Is Null"
27: 'や行
28: Case 8
29: strCritria = "WHERE (Asc([姓カナ])) Between 212 And 214) AND Not 姓カナ Is Null"
30: 'ら行
31: Case 9
32: strCritria = "WHERE (Asc([姓カナ]) Between 215 And 219) AND Not 姓カナ Is Null"
33: 'わ行
34: Case 10
35: strCritria = "WHERE (Asc([姓カナ]) Between 220 And 221) AND Not 姓カナ Is Null"
36: 'その他
37: Case 11
38: strCritria = "WHERE (Asc([姓カナ]) Not Between 177 And 221) AND Not 姓カナ Is Null"
39: End Select
40: strSql = "SELECT 個人情報.個人ID AS 番号, [姓] & ' ' & [名] & '(' & [姓カナ] & ' ' & [名カナ] & ')' AS 名前 " _
41: & "FROM 個人情報 "
42: strSql = strSql & strCritria _
43: & " ORDER BY 姓カナ, 名カナ;"
44: Me.frm名簿sub.Form.RecordSource = strSql
45: Me.frm名簿sub.Requery
46:End Sub
8行目以降に出てくる“Asc（）”関数は、指定した文字列内にある先頭の文字の文字コードを返します。その次の“Between
177 And 181”というのは、見たままの通に“１７７から１８１の間”という意味です。ですから、“Asc([姓カナ])
Between 177 And 181”というのは、苗字の頭文字の文字コードが１７７から１８１の間にあるものを示しています。ただし、このとき“Asc（）”に文字が含まれていないと実行時エラーが発生してしまいます。そのため“AND
Not 姓カナ Is Null”として［姓カナ］に文字が入っているテーブルのみを対象にするようにします。
残っているのはサブフォームに関するプログラムです。「名簿Sub」のレコードセレクタをクリックした時のプログラムを作成します。
動きとしては、「個人リスト」と「家族リスト」にチェックされているときは、セレクタをクリックした人の情報を
表示するようにします。「家族登録」にチェックされている場合は、現在表示されている人をセレクタをクリックした
人の家族として登録します。
「名簿Sub」フォームの①を2回クリックしてください。 １回だと”サブフォーム/サブレポート：・・・・・”となります。
もう一回クリックすると”フォーム”と表示されます。 これで、「名簿Sub」フォームをデザインで明けた時と同じになります。
もちろん「名簿Sub」フォームを直接デザインで表示しても結構です。「クリック時」のところに下のプログラムを書きます。
01:'概要：個人リスト」と「家族リスト」にチェックされているときは、セレクタをクリックした人の情報を
02:' 表示し、「家族登録」にチェックされている場合は、現在表示されている人をセレクタを
03:' クリックした人の家族として登録する。
04:Private Sub Form_Click()
05: Dim frm As Form_個人情報入力
06: Set frm = Forms![個人情報入力]
07: If Me.CurrentRecord = 0 Then Exit Sub
08: Select Case frm.grpリストタイプ
09: '個人名簿
10: Case 1
11: frm.txt個人ID = Me.txt番号
12: subSearchAddress
13: '家族登録用リスト
14: Case 2
15: If frm.txt個人ID = Me.txt番号 Or Not IsNull(frm.txt家族ID) Then Exit Sub
16: If MsgBox(Me.txt名前 & "の家族に加えますか?", vbQuestion + vbYesNo) = vbNo Then
17: Exit Sub
18: End If
19: AddFamilyList
20: frm.cmb連名印刷.Enabled = True
21: frm.cmb連名印刷.BackStyle = 1 '通常
22: frm.cmb連名印刷 = "いいえ"
23: '家族内リスト
24: Case 3
25: frm.txt個人ID = Me.txt個人ID
26: subSearchAddress
27: End Select
28:End Sub
5行目6行目でフォームオブジェクトを設定しています。これは今までに何度も出てきているので見慣れたものですが、7行目に“Me”があります。 では、この“Me”は何を示しているのでしょうか？以前「“Me”とは、現在アクティブになっているフォームやレポートオブジェクトを示します。」 と説明しました。今開かれているのは、“個人情報入力”フォームです。ですから“Me”はこの“個人情報入力”フォームを示しているように思われますが、 実は違います。この“Me”はプログラムが実行されているフォームやレポートを示します。このプログラムが実行されているのは、 “個人情報入力”フォームではなく“名簿Sub”フォームです。ですから、この“Me”は“名簿Sub”フォームを示しています。
7行目の“.CurrentRecord”はフォームに表示されているレコード数を示します。“名簿Sub”フォームに何も表示するものが無いのに それ以降のプログラムを実行するとエラーが発生します。そのため、ここでレコード数を調べて表示されているレコードが無い場合は、 プログラムから抜けるようにしています。
16行目に“MsgBox”があります。今までは、メッセージを表示するだけでしたが、 今回は、メッセージを表示して処理を続けて行うかどうかを問い合わせるようになっています。
１９行目が家族登録をするためのプログラムです。次のようになっています。
01:'概要：家族の登録を行う
02:Private Sub AddFamilyList()
03: Dim strSql As String
04: Dim db As Database
05: Dim rs As Recordset
06: Dim fm As Form_個人情報入力
07: Set db = CurrentDb
08: Set fm = Forms![個人情報入力]
09: '家族IDの付加
10: strSql = "SELECT 家族ID, 個人ID,家族順位" _
11: & " FROM 家族" _
12: & " WHERE 家族ID = DLookup('家族ID', '家族', '個人ID=" & Me.txt番号 & "');"
13: Set rs = db.OpenRecordset(strSql)
14: '新規家族登録
15: If rs.EOF Then
16: fm.txt家族ID = Nz(DMax("家族ID", "家族")) + 1
17: rs.AddNew
18: rs![家族ID] = fm.txt家族ID
19: rs![個人ID] = Me.txt番号
20: rs![家族順位] = 1
21: rs.Update
22: '2人目以上
23: Else
24: fm.txt家族ID = rs![家族ID]
25: End If
26: If MsgBox("現住所を世帯主にあわせますか？", vbYesNo + vbQuestion) = vbNo Then Exit Sub
27: strSql = "SELECT 家族.家族ID, 家族.家族順位, 住所.郵便番号, 住所.住所1, " _
28: & "住所.住所2, 住所.番地, 電話番号.電話番号 AS 電話, 電話番号_1.電話番号 AS FAX " _
29: & "FROM 家族 INNER JOIN (電話番号 AS 電話番号_1 RIGHT JOIN " _
30: & "(電話番号 RIGHT JOIN (現住所 LEFT JOIN 住所 ON 現住所.住所ID = 住所.住所ID) " _
31: & "ON 電話番号.電話ID = 現住所.電話ID) ON 電話番号_1.電話ID = 現住所.FAXID) " _
32: & "ON 家族.個人ID = 現住所.個人ID " _
33: & "WHERE (((家族.家族ID)=" & fm.txt家族ID & ") AND ((家族.家族順位)=1));"
34: Set rs = db.OpenRecordset(strSql)
35: If Not rs.EOF Then
36: fm.txt現住所郵便番号 = rs![郵便番号]
37: fm.txt現住所住所1 = rs![住所1]
38: fm.txt現住所住所2 = rs![住所2]
39: fm.txt現住所番地 = rs![番地]
40: fm.txt現住所電話 = rs![電話]
41: fm.txt現住所FAX = rs![FAX]
42: End If
43:End Sub
12行目に“DLookup（）”関数があります。指定されたテーブル又は、 クエリーに含まれるフィールドの値を求めることが出来ます。 SQLを作ったりしなくても値が求められるので簡単で 便利ですが、多用すると検索スピードが遅くなります。それと、DLookup関数で複数の人が同じテーブルを同時に検索しながら、 更新したりすると、 そのデータベースが壊れる確立が高いような気がします。 これは、はっきりとした裏付があるわけではなく、 これまでの経験からそういう傾向があるような気がするというだけです。 ですから、ネットワーク上で動かすよな システムでは、私はなるべくこの関数を使わないようにしています 。
14行目から25行目で新に家族のレコードを作るか、 既に在る家族に追加するかを決めています。
家族に追加する人の現住所は世帯主と同じだと思います。 いちいち入力するのは、面倒なので27行目から42行目で世帯主の現住所をコピーしてきています。
これで、やっと“個人情報入力”フォームに関連するほとんどのプログラムが出来ました。 後、フォームを開くときのプログラムと閉じるプログラムを作って完成です。
フォームを開くときのプログラムは、次のようになっています。家族用のサブフォームの初期化と印刷種類用の配列の初期化を行っています。
'概要：抽出用のサブフォームのソースを設定および印刷種類のCaptionの初期化
Private Sub Form_Open(Cancel As Integer)
ClearSubForm
Erase gPrnKind
End Sub
次がフォームを閉じでメニュー画面を表示するためのプログラムです。
'概要：この画面を閉じでメニュー画面を表示します。
Private Sub btn閉じる_Click()
DoCmd.OpenForm "メニュー"
DoCmd.Close acForm, "個人情報入力"
End Sub
最後にメニューから“個人情報入力”フォームを起動させるプログラムを作りましょう。
'概要：個人情報入力フォームの起動
Private Sub btn個人情報入力_Click()
DoCmd.OpenForm "個人情報入力"
DoCmd.Close acForm, "メニュー"
End Sub
長かったですね。ですが、まだ終わりませんよ。
(佐藤）まで電子メールでお送りください。
ただし、添付ファイルがある場合は、内容を確認せずに削除させて頂いておりますのでご了承ください。
Copyright (C) 株式会社アニシス