HOME > このページ
RecordsetCloneを利用したサンプルフォーム

 次の例は、RecordsetcloneBookmarkプロパティを利用したレコード検索・レコード削除の例です。レコード移動ボタンによる移動は最初は予約番号(昇順)によるものですが、「カナシメイ検索」実行後はカナシメイ(昇順)によって移動します。再度「予約番号検索」を実行すると、予約番号(昇順)によって移動します。レコード数が多いときはあまり有効な検索ではありませんが、少ないときは簡単で便利です。






■テーブル「T_予約者」について

フィールド名 データ型 サイズ 備考
SEQ オートナンバー型 長整数型  
予約番号 テキスト型 7 上位2桁はcode
code テキスト型 2  
氏名 テキスト型 20  
カナシメイ テキスト型 20  
郵便 テキスト型 7 書式 &&&-&&&&
住所1 テキスト型 50  
住所2 テキスト型 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 = "カナシメイ"   ’--------------(1)
    Me.OrderByOn = True    ’--------------(2) 
    
    Set RS = Me.RecordsetClone  ’--------------------(3)
    RS.FindFirst "カナシメイ=" & "'" & Me.cbokana & "'"  ’-------------(4)
    Me.Bookmark = RS.Bookmark   ’------------------------(5)
    Set RS = Nothing        ’-------------------------(6)
End Sub
【解説】
(1)「カナシメイ」フィールドを使って昇順に並べ替える条件式を作成し、OrderBy プロパティに設定します。
(2)設定した並べ替えを適用します。
(3)フォームのレコードソースをもとに、レコードセットを作成しています。
(4)コンボボックス「cbokana」の値で(3)のレコードセットを検索します。
(5)レコードセットのBookmarkプロパティの値をフォームのBookmarkプロパティの値に代入することでレコードセットの内容をフォームに表示しています。
(6)レコードセット変数を削除しています。


○cmd削除_Click プロシジャ
Private Sub cmd削除_Click()
   Dim RS As DAO.Recordset
   If vbYes = MsgBox("表示中のレコードを削除してもいいですか?", vbYesNo) Then

      Set RS = Me.RecordsetClone
      RS.Bookmark = Me.Bookmark    '---------------(1)
      RS.Delete          '---------------(2) 
      Set RS = Nothing
      MsgBox "削除しました。"
   Else
     MsgBox "処理はキャンセルされました。"
     Me.予約番号.SetFocus
   End If
  Set RS = Nothing 
End Sub
【解説】
(1)フォームのBookmarkプロパティの値をレコードセットのBookmarkプロパティの値に代入しています。これによってフォーム上に表示されているレコードがレコードセットのカレントレコードになっています。
(2)カレントレコードを削除します。


○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 = "予約番号"     ’------------------(1)
    Me.OrderByOn = True       ’------------------(2)
    Set RS = Me.RecordsetClone    ’---------------------(3)
    RS.FindFirst "予約番号=" & "'" & Me.cbo予約番号 & "'"   ’---------(4)
    Me.Bookmark = RS.Bookmark     ’-------------------(5)    
    Set RS = Nothing          ’----------------------(6)
    End Sub
【解説】
(1)「予約番号」フィールドを使って昇順に並べ替える条件式を作成し、OrderBy プロパティに設定します。
(2)設定した並べ替えを適用します。
(3)フォームのレコードソースをもとに、レコードセットを作成しています。
(4)コンボボックス「予約番号」の値で(3)のレコードセットを検索します。
(5)レコードセットのBookmarkプロパティの値をフォームのBookmarkプロパティの値に代入することでレコードセットの内容をフォームに表示しています。
(6)レコードセット変数を削除しています。


○郵便_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")   ’------(1)
    Set RS = DB.OpenRecordset(SQL)                                   ’------------(2)
    
    If RS.RecordCount > 0 Then
       Me.住所1 = RS!住所1 & RS!住所2 & RS!住所3 & RS!住所4         ’------------------(3)
       Me.住所2.SetFocus                            ’-----------------------(4)
    End If
  Set RS = Nothing 
    Set DB = Nothing 
End Sub
【解説】住所入力にはDownLoadコーナーの「郵便番号検索ツール(改訂版)」の「郵便番号検索ver2.mdb」を利用します。アクセスの住所入力支援機能を利用できますが、データの更新に難点があります。
(1)外部データベース「郵便番号検索ver2.mdb」に接続しています。
(2)郵便番号がテキストボックス「郵便」の値と一致するレコードセットを作成しています。
(3)レコードセットが空でないときテキストボックス「住所1」にRS!住所1 & RS!住所2 & RS!住所3 & RS!住所4の値を代入しています。
(4)テキストボックス「住所2」にフォーカスを移動しています。


○郵便_DblClick プロシジャ
'郵便番号修正
Private Sub 郵便_DblClick(Cancel As Integer)
    Me.郵便 = Null
    Me.住所1 = Null
    Me.住所2 = Null
End Sub
【解説】テキストボックス「郵便」をダブルクリックすると、テキストボックス「郵便」「住所1 」「住所2」にNULL値が代入されます。


○住所2_AfterUpdate サブプロシジャ
'大文字・全角文字に変換
Private Sub 住所2_AfterUpdate()
    Me.住所2 = StrConv(Me.住所2, vbWide)      ’------------(1)
    Me.住所2 = StrConv(Me.住所2, vbUpperCase)    ’------------(2)
End Sub
【解説】
(1)テキストボックス「住所2」の文字列を全角に変換しています。
(2)テキストボックス「住所2」の文字列を大文字に変換しています。
この操作で「a-1-22-302」は「A−1−22−302」に変換されます。


○クラス_AfterUpdate プロシジャ
'大文字に変換
Private Sub クラス_AfterUpdate()
    If IsNull(Me.クラス) = False Then
      Me.クラス = StrConv(Me.クラス, vbUpperCase)  ’------------(1)
    End If
End Sub
【解説】テキストボックス「クラス」には英字2文字を入力します。
(1)テキストボックス「クラス」の文字列を大文字に変換しています。


○予約番号_AfterUpdate プロシジャ
Private Sub 予約番号_AfterUpdate()
   Me.code = Left(Me.予約番号, 2)
End Sub
【解説】テキストボックス「code」にテキストボックス「予約番号」の上位2桁の数字を代入しています。


○入学日_AfterUpdate プロシジャ
'日付け表示
Private Sub 入学日_AfterUpdate()
   If Len(Me.入学日) = 6 Then
     Me.入学日 = 日付(Me.入学日)
   End If
End Sub
【解説】入学日は2005年4月1日は「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  ’-------------------------(1)
    DoCmd.RunSQL "DELETE * FROM T_予約者 _ 
                      WHERE ((T_予約者.予約番号 Is Null) or (T_予約者.氏名 Is Null));" ’---(2)
    DoCmd.SetWarnings True  ’--------------------------(3) 
    DoCmd.Quit        ’--------------------------(4)
End Sub
【解説】
(1)レコード削除時に表示される警告が出ないようにしています。
(2)「予約番号」または「氏名」が未入力のレコードを削除しています。
(3)警告メッセジの設定を元に戻しています
(4)アクセスを終了します。

■ ダウンロード
  
アイコンを右クリックして「対象をファイルに保存(A)」を選択して下さい。「sampleclone.lzh」がダウンロードされます。解凍ソフトで解凍してください。


ホームページに|前のページに|次のページに

CopyRight(C) 2004 cbcnet. All Rights Reserved