Access2007の、フォーム入力について

質問

下記のようなコマンドを、ボタンに追加しました。

名前の欄に入力して、ボタンを押すと、レコードの名前フィールドに入力されます。

Private Sub コマンド10_Click()

If Nz(Me.名前1, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前1 & "'"
End If

If Nz(Me.名前2, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前2 & "'"
End If

If Nz(Me.名前3, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前3 & "'"
End If

If Nz(Me.名前4, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前4 & "'"
End If

If Nz(Me.名前5, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前5 & "'"
End If

DoCmd.Close acForm, "フォーム1"

End Sub

テキストボックスには、それぞれ名前1～5、という名前がつけられています。レコードが追加されるテーブルは「氏名」です。

そこで、さらにテーブルに部署フィールドを追加して、フォームに上から、部署1～5のテキストボックスを追加し、

名前と部署のテキストボックスの、それぞれ対応しているものが、同じレコードに追加されるようにするには
どうすればよいでしょうか？

有識者の皆さま、どうぞよろしくお願いいたします。

回答No.4

hatena1989 · ベストアンサー

追加クエリを使う場合、

Private Sub コマンド10_Click()
　　Dim i As Long

　　For i = 1 to 5
　　　　If Nz(Me("名前" & i))<>"" Then
　　　　　　CurrentDb.Execute "INSERT INTO 氏名 (名前, 部署) " & _
　　　　　　"VALUES ('" & Me("名前" & i) & "','" & Me("部署" & i) & "')"
　　　　End If
　　Next

DoCmd.Close acForm, "フォーム1"
End Sub

DAOを使う場合、

Private Sub コマンド10_Click()
　　Dim ra As DAO.Reocrdset
　　Dim i As Long

　　Set rs = CurrentDb.OpenRecordset("氏名", , dbAppendOnly)

　　For i = 1 to 5
　　　　If Nz(Me("名前" & i))<>"" Then
　　　　　　rs.AddNew
　　　　　　rs!名前 = Me("名前" & i)
　　　　　　rs!名前 = Me("所属" & i)
　　　　　　rs.update
　　　　End If
　　Next

　　rs.Close: Set rs = Nothing
　　DoCmd.Close acForm, "フォーム1"
End Sub

でどうでしょうか。

重複チェック処理はしてませんので、必用に応じて追加してください。

回答No.3

piroin654

No2の説明をもう少し。

質問の内容に沿ったNo1では名前を探しましたが、
この方法では、もし同姓同名の
人物が登録されていたら、その人物の
部署を変更することになります。

No2の場合は、No1とは違い、
名前1と部署1、
名前2と部署2
・
・
名前5と部署5
をそれぞれ一つのレコードとして
テーブルに追加します。
したがって、万が一にも他の部署に
同姓同名の人物がある場合にも
対応できます。
あるいは、同姓同名の人物が同じ
部署にいる場合も登録します。

もちろん、このような新規追加の場合
同一人物を間違って他の部署にも登録
するということが起こりかねないこと
は十分注意をすることが必要です。

そのためにも、個人を特定する電話番号
などをテーブルに追加する前に確認すること
も必要かと思いますが。

回答No.2

piroin654

No1です。
もう一つの方法。

DAOを使っているので、コード表のツールから
参照設定を選択して、
Microsoft DAO xx Object Library
にチェックを入れて、OKとします。xxは3.6のような数字です。
このとき、
Microsoft ActiveX Data Objects xx Library
にチェックが入っていたらはずしてください。

Private Sub コマンド10_Click()
Dim db As Database
Dim rs As Recordset
Dim ctl1 As Control
Dim ctl2 As Control
Dim i As Long
Dim strName As String
Dim strSection As String

Set db = CurrentDb
Set rs = db.OpenRecordset("氏名", dbOpenDynaset)

For i = 1 To 5

'各名前のテキストボックスのデータの取り出し
For Each ctl1 In Me.Controls
If TypeOf ctl1 Is TextBox Then

If ctl1.Name = "名前" & i Then
'If ctl1.Value <> "" Then
strName = Nz(ctl1.Value)
'End If
End If
End If
Next ctl1

'各部署のテキストボックスのデータの取り出し
For Each ctl2 In Me.Controls
If TypeOf ctl2 Is TextBox Then
If ctl2.Name = "部署" & i Then
'If ctl2.Value <> "" Then
strSection = Nz(ctl2.Value)
'End If
End If
End If
Next ctl2

'テーブルへ追加
If strName <> "" Then
If strSection <> "" Then
rs.AddNew
rs!名前 = strName
rs!部署 = strSection
rs.Update
End If
End If

'変数の初期化
strName = ""
strSection = ""

Next i

rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

コードの中でコメントアウトしているところが
あります。この部分はテーブルへの追加の
ところでデータが無い場合のフィルターをかけて
いるのでコメントアウトしています。

For i = 1 To 5

で、名前1～名前5、部署1～部署5
のデータを検索します。

回答No.1

piroin654

必ず名前が重複しない、
かつ、名前と部署が両方入力されている、
ということならば、

Private Sub コマンド10_Click()
If Nz(Me.名前1, "") <> "" Then
If Nz(Me.部署1, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前1 & "'"
CurrentDb.Execute "UPDATE 氏名 SET 部署 = '" & Me.部署1 & "' WHERE 名前 = '" & Me.名前1 & "'"
End If
End If

If Nz(Me.名前2, "") <> "" Then
If Nz(Me.部署2, "") <> "" Then
CurrentDb.Execute "INSERT INTO 氏名 (名前) SELECT '" & Me.名前2 & "'"
CurrentDb.Execute "UPDATE 氏名 SET 部署 = '" & Me.部署2 & "' WHERE 名前 = '" & Me.名前2 & "'"
End If
End If

'以下省略

End Sub

どちらかが未入力ならば、という場合もありますが。
その場合、データベースとして成り立つかどうか
質問内容からはわからないので、省略します。

お礼

試してみます、貴重なご回答をありがとうございます！