| 次の例は、RecordsetcloneとBookmarkプロパティを利用したレコード検索・レコード削除の例です。レコード移動ボタンによる移動は最初は予約番号（昇順）によるものですが、「カナシメイ検索」実行後はカナシメイ（昇順）によって移動します。再度「予約番号検索」を実行すると、予約番号（昇順）によって移動します。レコード数が多いときはあまり有効な検索ではありませんが、少ないときは簡単で便利です。 |
 |
| RecordsetCloneを利用したサンプルフォーム |
| 次の例は、RecordsetcloneとBookmarkプロパティを利用したレコード検索・レコード削除の例です。レコード移動ボタンによる移動は最初は予約番号（昇順）によるものですが、「カナシメイ検索」実行後はカナシメイ（昇順）によって移動します。再度「予約番号検索」を実行すると、予約番号（昇順）によって移動します。レコード数が多いときはあまり有効な検索ではありませんが、少ないときは簡単で便利です。 |
|
■テーブル「T_予約者」について
フィールド名 データ型 サイズ 備考 SEQ オートナンバー型 長整数型 予約番号 テキスト型 7 上位2桁はcode code テキスト型 2 氏名 テキスト型 20 カナシメイ テキスト型 20 郵便 テキスト型 7 書式 &&&-&&&& 住所１ テキスト型 50 住所２ テキスト型 50 番地以降 電話 テキスト型 16 予約日 テキスト型 8 05/04/01の型で保存 クラス テキスト型 2 英字大文字
■ プロシジャについて
○Form_Open プロシジャ
Private Sub Form_Open(Cancel As Integer)
DoCmd.Restore
'コンボボックスcbocodeのプロパティの設定
With Me.cbocode
.RowSourceType = "Table/Query"
.RowSource = "SELECT DISTINCT T_予約者.code FROM T_予約者;"
.ColumnCount = 1
.BoundColumn = 1
End With
'コンボボックスcbo予約番号のプロパティの設定
With Me.cbo予約番号
.RowSourceType = "Table/Query"
.RowSource = "SELECT T_予約者.予約番号, T_予約者.氏名 FROM T_予約者 " _
& "WHERE (((T_予約者.予約番号) Like [forms]![F_予約者入力]![cbocode] & '*')) "
.ColumnCount = 2
.BoundColumn = 1
End With
'コンボボックスcbofilterのプロパティの設定
With Me.cbofilter
.RowSourceType = "Value List"
.RowSource = "ｱ;ｶ;ｻ;ﾀ;ﾅ;ﾊ;ﾏ;ﾔ;ﾗ;ﾜ"
.ColumnCount = 1
.BoundColumn = 1
End With
'フォームのレコードソースの設定
Me.RecordSource = "SELECT * FROM T_予約者 ORDER BY T_予約者.SEQ;"
End Sub
【解説】コンボボックスのプロパティとフォームのレコードソースを設定しています。コンボボックスについてはこちらを参照してください。
○cbofilter_AfterUpdate プロシジャ
Private Sub cbofilter_AfterUpdate()
Dim SQL As String
Me.cbokana = Null
Me.cbo予約番号 = Null: Me.cbocode = Null
SQL = "SELECT ｶﾅｼﾒｲ,氏名 FROM T_予約者 "
Select Case Me.cbofilter
Case "ｱ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ｱ-ｵ]*' "
Case "ｶ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ｶ-ｺﾞ]*' "
Case "ｻ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ｻ-ｿﾞ]*' "
Case "ﾀ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾀ-ﾄﾞ]*' "
Case "ﾅ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾅ-ﾉ]*' "
Case "ﾊ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾊ-ﾎﾞ]*' "
Case "ﾏ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾏ-ﾓ]*' "
Case "ﾔ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾔ-ﾖ]*' "
Case "ﾗ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾗ-ﾛ]*' "
Case "ﾜ": SQL = SQL & "WHERE ｶﾅｼﾒｲ LIKE '[ﾜ-ﾝ]*' "
End Select
SQL = SQL & "ORDER BY ｶﾅｼﾒｲ"
'コンボボックスcbokanaのプロパティの設定
With Me.cbokana
.RowSourceType = "Table/Query"
.RowSource = SQL
.ColumnCount = 2
.BoundColumn = 1
End With
Me.cbokana.Requery
End Sub
【解説】コンボボックス「cbofilter」の値を用いてコンボボックス「cbokana」のプロパティを設定し再クエリを実行しています。これによって、コンボボックス「cbofilter」の値が「ｱ」のとき、コンボボックス「cbokana」にはカナシメイの最初のカナが「ｱ〜ｵ」で始まるレコードが表示されます。
○cbokana_AfterUpdate プロシジャ
'ｶﾅｼﾒｲの検索
Private Sub cbokana_AfterUpdate()
Dim RS As DAO.Recordset
Me.OrderBy = "ｶﾅｼﾒｲ" ’--------------（１）
Me.OrderByOn = True ’--------------（２）
Set RS = Me.RecordsetClone ’--------------------（３）
RS.FindFirst "ｶﾅｼﾒｲ=" & "'" & Me.cbokana & "'" ’-------------（４）
Me.Bookmark = RS.Bookmark ’------------------------（５）
Set RS = Nothing ’-------------------------（６）
End Sub
【解説】
（１）「ｶﾅｼﾒｲ」フィールドを使って昇順に並べ替える条件式を作成し、OrderBy プロパティに設定します。
（２）設定した並べ替えを適用します。
（３）フォームのレコードソースをもとに、レコードセットを作成しています。
（４）コンボボックス「cbokana」の値で（３）のレコードセットを検索します。
（５）レコードセットのBookmarkプロパティの値をフォームのBookmarkプロパティの値に代入することでレコードセットの内容をフォームに表示しています。
（６）レコードセット変数を削除しています。
○cmd削除_Click プロシジャ
Private Sub cmd削除_Click()
Dim RS As DAO.Recordset
If vbYes = MsgBox("表示中のレコードを削除してもいいですか？", vbYesNo) Then
Set RS = Me.RecordsetClone
RS.Bookmark = Me.Bookmark '---------------（１）
RS.Delete '---------------（２）
Set RS = Nothing
MsgBox "削除しました。"
Else
MsgBox "処理はキャンセルされました。"
Me.予約番号.SetFocus
End If
Set RS = Nothing
End Sub
【解説】
（１）フォームのBookmarkプロパティの値をレコードセットのBookmarkプロパティの値に代入しています。これによってフォーム上に表示されているレコードがレコードセットのカレントレコードになっています。
（２）カレントレコードを削除します。
○cbocode_Click プロシジャ
''予約番号検索検索準備
Private Sub cbocode_AfterUpdate()
Me.cbo予約番号 = Null
Me.cbofilter = Null: Me.cbokana = Null
Me.cbo予約番号.Requery
End Sub
【解説】コンボボックス「cbo予約番号」「cbofilter」「cbokana」にNULL値を代入して、コンボボックス「cbo予約番号」を再クエリしています。
○cbo予約番号_AfterUpdate プロシジャ
'予約番号検索
Private Sub cbo予約番号_AfterUpdate()
Dim RS As DAO.Recordset
Me.OrderBy = "予約番号" ’------------------（１）
Me.OrderByOn = True ’------------------（２）
Set RS = Me.RecordsetClone ’---------------------（３）
RS.FindFirst "予約番号=" & "'" & Me.cbo予約番号 & "'" ’---------（４）
Me.Bookmark = RS.Bookmark ’-------------------（５）
Set RS = Nothing ’----------------------（６）
End Sub
【解説】
（１）「予約番号」フィールドを使って昇順に並べ替える条件式を作成し、OrderBy プロパティに設定します。
（２）設定した並べ替えを適用します。
（３）フォームのレコードソースをもとに、レコードセットを作成しています。
（４）コンボボックス「予約番号」の値で（３）のレコードセットを検索します。
（５）レコードセットのBookmarkプロパティの値をフォームのBookmarkプロパティの値に代入することでレコードセットの内容をフォームに表示しています。
（６）レコードセット変数を削除しています。
○郵便_AfterUpdate プロシジャ
Private Sub 郵便_AfterUpdate()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim SQL As String
SQL = "SELECT * FROM T_住所録 WHERE 郵便番号=" & "'" & Me.郵便 & "'"
Set DB = DBEngine.Workspaces(0).OpenDatabase("D:\Access2003_
\郵便番号\郵便番号検索ver2.mdb") ’------（１）
Set RS = DB.OpenRecordset(SQL) ’------------（２）
If RS.RecordCount > 0 Then
Me.住所1 = RS!住所1 & RS!住所2 & RS!住所3 & RS!住所4 ’------------------（３）
Me.住所2.SetFocus ’-----------------------（４）
End If
Set RS = Nothing
Set DB = Nothing
End Sub
【解説】住所入力にはDoｗｎLoadコーナーの「郵便番号検索ツール（改訂版）」の「郵便番号検索ver2.mdb」を利用します。アクセスの住所入力支援機能を利用できますが、データの更新に難点があります。
（１）外部データベース「郵便番号検索ver2.mdb」に接続しています。
（２）郵便番号がテキストボックス「郵便」の値と一致するレコードセットを作成しています。
（３）レコードセットが空でないときテキストボックス「住所1」にRS!住所1 & RS!住所2 & RS!住所3 & RS!住所4の値を代入しています。
（４）テキストボックス「住所2」にフォーカスを移動しています。
○郵便_DblClick プロシジャ
'郵便番号修正
Private Sub 郵便_DblClick(Cancel As Integer)
Me.郵便 = Null
Me.住所1 = Null
Me.住所2 = Null
End Sub
【解説】テキストボックス「郵便」をダブルクリックすると、テキストボックス「郵便」「住所1 」「住所2」にＮＵＬＬ値が代入されます。
○住所2_AfterUpdate サブプロシジャ
'大文字・全角文字に変換
Private Sub 住所2_AfterUpdate()
Me.住所2 = StrConv(Me.住所2, vbWide) ’------------（１）
Me.住所2 = StrConv(Me.住所2, vbUpperCase) ’------------（２）
End Sub
【解説】
（１）テキストボックス「住所2」の文字列を全角に変換しています。
（２）テキストボックス「住所2」の文字列を大文字に変換しています。
この操作で「a-1-22-302」は「Ａ−1−２２−３０２」に変換されます。
○クラス_AfterUpdate プロシジャ
'大文字に変換
Private Sub クラス_AfterUpdate()
If IsNull(Me.ｸﾗｽ) = False Then
Me.ｸﾗｽ = StrConv(Me.ｸﾗｽ, vbUpperCase) ’------------（１）
End If
End Sub
【解説】テキストボックス「ｸﾗｽ」には英字２文字を入力します。
（１）テキストボックス「ｸﾗｽ」の文字列を大文字に変換しています。
○予約番号_AfterUpdate プロシジャ
Private Sub 予約番号_AfterUpdate() Me.code = Left(Me.予約番号, 2) End Sub
【解説】テキストボックス「code」にテキストボックス「予約番号」の上位２桁の数字を代入しています。
○入学日_AfterUpdate プロシジャ
'日付け表示
Private Sub 入学日_AfterUpdate()
If Len(Me.入学日) = 6 Then
Me.入学日 = 日付(Me.入学日)
End If
End Sub
【解説】入学日は２００５年４月１日は「05/04/01」の型の文字列で保存します。次のFunction プロシジャ「Function 日付」によって「050401」と入力すると上の型に自動変換されます。
Public Function 日付(x As String) As String
日付 = Left(x, 2) & "/" & Mid(x, 3, 2) & "/" & Right(x, 2)
End Function
○レコード移動
'最初のレコードに移動
Private Sub cmd最初_Click()
On Error GoTo Err_cmd最初_Click
DoCmd.GoToRecord , , acFirst
Exit_cmd最初_Click:
Exit Sub
Err_cmd最初_Click:
MsgBox Err.Description
Resume Exit_cmd最初_Click
End Sub
'新規のレコードに移動
Private Sub cmd新規_Click()
On Error GoTo Err_cmd新規_Click
DoCmd.GoToRecord , , acNewRec
Exit_cmd新規_Click:
Exit Sub
Err_cmd新規_Click:
MsgBox Err.Description
Resume Exit_cmd新規_Click
End Sub
'前のレコードに移動
Private Sub cmd前_Click()
On Error GoTo Err_cmd前_Click
DoCmd.GoToRecord , , acPrevious
Exit_cmd前_Click:
Exit Sub
Err_cmd前_Click:
MsgBox Err.Description
Resume Exit_cmd前_Click
End Sub
'最後のレコードに移動
Private Sub cmd最後_Click()
On Error GoTo Err_cmd最後_Click
DoCmd.GoToRecord , , acLast
Exit_cmd最後_Click:
Exit Sub
Err_cmd最後_Click:
MsgBox Err.Description
Resume Exit_cmd最後_Click
End Sub
'次のレコードに移動
Private Sub cmd次_Click()
On Error GoTo Err_cmd次_Click
DoCmd.GoToRecord , , acNext
Exit_cmd次_Click:
Exit Sub
Err_cmd次_Click:
MsgBox Err.Description
Resume Exit_cmd次_Click
End Sub
【解説】DoCmd.GoToRecord についてはこちらを参照して下さい。
○cmd終了_Click プロシジャ
'フォームを閉じる
Private Sub cmd終了_Click()
DoCmd.SetWarnings False ’-------------------------（１）
DoCmd.RunSQL "DELETE * FROM T_予約者 _
WHERE ((T_予約者.予約番号 Is Null) or (T_予約者.氏名 Is Null));" ’---（２）
DoCmd.SetWarnings True ’--------------------------（３）
DoCmd.Quit ’--------------------------（４）
End Sub
【解説】
（１）レコード削除時に表示される警告が出ないようにしています。
（２）「予約番号」または「氏名」が未入力のレコードを削除しています。
（３）警告メッセジの設定を元に戻しています
（４）アクセスを終了します。
■ ダウンロード
アイコンを右クリックして「対象をファイルに保存(A)」を選択して下さい。「sampleclone.lzh」がダウンロードされます。解凍ソフトで解凍してください。