Microsoft Access2003

Page 2 (2004/12)

新規データ入力専用フォームに改良
前のページのフォーム「DVD」はテーブル「DVD」に連結したもので、教科書的とも言えます。
できることは・・というと、各レコードへ移動しながら内容を変更するということと、新しいレコードを追加するということです。

データ量が増えた場合は検索機能が必要ですが、これはとりあえず後回しにして、データの追加登録専用のフォームを作ってみました。

フォームに連結したテーブルを開きっぱなしにして、データをいつでも変更できるのは実務の面では大きなマイナスです。
こちらの新規登録専用フォーム「frmNewData」では、新しいデータをフォームのコントロールに入力した後、登録ボタンをクリックすることによって、追加登録しています。

このようにすると、テーブルを開くのは追加登録する時だけの短時間ですみ安全な感じがします。

フォームの基本的な機能は前のフォームと同じなので、丸ごとコピーし、レコードソースのリンクを外しました。
新たに「原題」というフィールドも追加しました。

このフォームのイベントプロシージャ・ファイルを下に貼りつけましたが、大半は前のフォームからの持ち越しです。

このパターンは現在仕事で動いているシステムから、必要な部分をコピーして修正したので、作業は早いですし、使い込んだシステムからのコピーなのでミスで四苦八苦することもありませんでした。
Option Compare Database

Private Sub cmdデータ登録_Click()
  '登録ボタンでフォームに入力したデータを登録する
  Dim dbs As Database, rst As Recordset
  If Not IsNull(txtタイトル) Then
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("DVD", dbOpenTable)
    With rst
      .AddNew
      !タイトル = txtタイトル
      !原題 = txt原題
      !監督名 = cbo監督名
      !出演者1 = cbo出演者1
      !出演者2 = cbo出演者2
      !出演者3 = cbo出演者3
      !出演者4 = cbo出演者4
      !出演者5 = cbo出演者5
      !制作年 = txt制作年
      !データソース = cboデータソース
      .Update
    End With
    Beep
    MsgBox "データを登録しました"
    Me.Refresh 'これは必要ないか?
    rst.Close
    dbs.Close
    txtタイトル.SetFocus
  End If
   
End Sub

Private Sub txtタイトル_BeforeUpdate(Cancel As Integer)
  '重複登録防止のためタイトル名を検索する。登録済みの場合は再入力
  If Not IsNull(txtタイトル) Then
    Dim db As Database, rs As Recordset
    Set db = CurrentDb
    Set rs = db.OpenRecordset("DVD", dbOpenDynaset)
    rs.FindFirst "[タイトル] = '" & txtタイトル & "'"
    If Not rs.NoMatch Then
      MsgBox ("登録済みのタイトルです")
      Cancel = True
    End If
  End If
End Sub

Private Sub txtタイトル_GotFocus()
  Me.cmdデータ登録.Enabled = False 'データ登録ボタンを使用不可にする
  
  Dim ctl As Control  'データをクリヤする
  For Each ctl In Controls
    If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
      ctl.Value = Null
    End If
  Next
End Sub

Private Sub txtタイトル_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyEscape Then 'ESCキーでフォームを閉じる
    DoCmd.Close
  End If
End Sub

Private Sub cbo監督名_NotInList(NewData As String, response As Integer)
  'テーブル「監督名」に新しいデータを登録する
  Dim db As Database
  Dim rs As Recordset
  Dim Msg As String
  If NewData = "" Then Exit Sub
  Msg = "'" & NewData & "' は未登録です。" & vbCr & vbCr
  Msg = Msg & "追加登録しますか?"
  If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then
    response = acDataErrContinue
    MsgBox "Please try again."
  Else
    Set db = CurrentDb
    Set rs = db.OpenRecordset("監督名", dbOpenDynaset)
    rs.AddNew
    rs![監督名] = NewData
    rs.Update
    response = acDataErrAdded
  End If
End Sub

Private Sub cbo出演者1_NotInList(NewData As String, response As Integer)
  New_Actor NewData, response
End Sub

Private Sub cbo出演者2_NotInList(NewData As String, response As Integer)
  New_Actor NewData, response
End Sub

Private Sub cbo出演者3_NotInList(NewData As String, response As Integer)
  New_Actor NewData, response
End Sub

Private Sub cbo出演者4_NotInList(NewData As String, response As Integer)
  New_Actor NewData, response
End Sub

Private Sub cbo出演者5_NotInList(NewData As String, response As Integer)
  New_Actor NewData, response
End Sub

Sub New_Actor(NewData As String, response As Integer)
  '俳優名の新規登録ルーチン
  Dim db As Database
  Dim rs As Recordset
  Dim Msg As String
  
  If NewData = "" Then Exit Sub
  
  Msg = "'" & NewData & "' はリストにありません." & vbCr & vbCr
  Msg = Msg & "追加登録しますか??"
  If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then
    response = acDataErrContinue
    MsgBox "再入力してください."
  Else
    Set db = CurrentDb
    Set rs = db.OpenRecordset("俳優名")
    rs.AddNew
    rs![俳優名] = NewData
    rs.Update
    response = acDataErrAdded
  End If
End Sub

Private Sub cmdClose_Click()
'フォームを閉じるボタン
On Error GoTo Err_cmdClose_Click
    DoCmd.Close

Exit_cmdClose_Click:
  Exit Sub

Err_cmdClose_Click:
  MsgBox Err.Description
  Resume Exit_cmdClose_Click
  
End Sub

Private Sub txtタイトル_LostFocus()
  Me.cmdデータ登録.Enabled = True 'タイトル・フィールドを抜け出すと登録ボタンが使用可能にする
End Sub

Private Sub txt原題_GotFocus()
  If IsNull(txtタイトル) Then 'ここでタイトルの未入力をチェックする。未入力の場合は戻る
    MsgBox ("タイトル名を入力してください")
    Me.txtタイトル.SetFocus
  End If
End Sub
アプリケーションを作るとき、一番手がかかって大変で、それでも面白いのはデータ入力の部分かもしれません。
誤操作をせず使い勝手の良い仕組みを考えるのは刺激的であるとも言えるでしょう。
下の図は、データ入力部を修正しながら入力した現在のテーブルDVDの内容です。オートナンバー型で連番のはずのフィールド「DVD_ID」が途中で数字が大きく飛んでいるのは悪戦苦闘の結果です(/_;) ちょっと見苦しいのでこのあと修正しましたけど・・・・。


Page Topへ戻る