AccessのVBAを使って、サブフォームにレコードを表示させたい

Accessにサブフォームを二つと、ボタンを一つ作りました。
サブフォーム１に商品コードを入力し、ボタンをクリックすると、
商品マスタからデータを取得し、サブフォーム２に値を表示させるようにしたいです。

サブフォーム１

商品コード
A001
B001
C001

サブフォーム２

商品コード	商品名	単価
A001	りんご	100
B001	ぶどう	200
C001	柿	80

VBA
1
2Dim rst_sub1 As DAO.Recordset 'サブフォーム1用
3Dim sfrm2 As SubForm 'サブフォーム2
4Set sfrm2 = Me!サブフォーム２
5Dim rst_sub2 As Recordset
6Set rst_sub2 = sfrm.Form.Recordset
7
8Set rst_sub1 = CurrentDb.OpenRecordset("テーブル_サブフォーム1", dbOpenTable)
9Dim record_count As Long
10record_count = rst_sub1.RecordCount
11
12If record_count = 0 Then
13    Exit Sub
14End If
15
16rst_sub1.MoveFirst
17
18For i = 1 To record_count
19    rst_sub2.AddNew
20    rst_sub2.Fields("商品コード") = rst_sub1.Fields("商品コード")
21    rst_sub2.Update
22
23    rst_sub1.MoveNext
24    rst_sub2.MoveNext
25Next i

このコードを実行しますと、rst_sub2.MoveNextで次のようなエラーが出ます。

実行時エラー'3021':
カレントレコードがありません。

しかし、サブフォーム２に、商品マスタから取得した値が1行だけ正しく表示されています。
(本来なら、サブフォーム1に3行あれば、サブフォーム２にも3行表示されるはずですが、1行だけ表示されます。しかし、この1行に表示されている値は正しいものです。)

このrst_sub2.MoveNextを削除しますと、
今後は、サブフォーム２に#Name?と表示されるようになり、
正しい値が1行も表示されなくなります。

どのようにすればサブフォームに正しい値を表示させられるか、ご教授のほど、よろしくお願いいたします。

sousuke

2020/10/09 03:25

コードを抜粋してないですか？sfrmという変数は無いように見えます。入力テーブルと商品マスタをleftjoinしたクエリをサブフォーム2のレコードソースにするという内容は難しいですか？

sazi

2020/10/09 06:37 編集

> サブフォーム1に3行あれば、サブフォーム２にも3行表示されるはずですがでは、なぜサブフォームを分けるのですか？通常、複数のサブフォームで構成する場合、ドリルダウン（親を選択したら、該当する子だけを表示）したい時などですが。１：１なら敢えてフォーム（強いて言うならマスターさえ）を分ける必要は無いと思いますけれど。

行動規範の内容に同意します

回答1件

ベストアンサー

質問者様
サブフォーム１→商品マスタフォーム
サブフォーム２→商品価格マスタフォーム
として
[テーブル_サブフォーム2]:商品価格マスタフォーム用

として
画面

を作成しました。
※ フォームの作成はフォームウイザードの表形式を使用

商品マスタフォームに「商品取得」ボタン(b商品取得)を追加

ここまでが質問者様の内容に沿ったフォームの構成の再現です

処理に関して言えばちょっと惜しい事になっていました
変更および追加等したところは※で記載しています。
処理として大きく気になったのが「重複登録できてしまう事」
内容から察するに同じ商品が登録されるのはまずいので処理を追加しました。
あとループはレコードセットを扱う場合「Do Until」のほうが扱いやすいので
その様に変更しています。

rst_sub2.MoveNext

これに関しては新規のレコードを追加(つまりレコードの最後)の場合
これ以上次に行けないのでエラーとなります。
ただ消した際の表示が無くなる現象は再現できませんでした。
その防止と商品名の表示の為[sfrm2.Requery]を最後に行っています。

VBA
1Private Sub b商品取得_Click()
2    Dim rst_sub1    As DAO.Recordset    'サブフォーム1用
3    Dim sfrm2       As SubForm          'サブフォーム2
4    Set sfrm2 = Me.Parent.商品価格マスタ
5    'Set sfrm2 = Me!サブフォーム2       '※名称変更の為
6    Dim rst_sub2    As Recordset        'サブフォーム2用
7    Set rst_sub2 = sfrm2.Form.Recordset
8
9    'Set rst_sub1 = CurrentDb.OpenRecordset("テーブル_サブフォーム1", dbOpenTable)
10    Set rst_sub1 = Me.Recordset         '※自フォームの内容なので再取得せずにレコードセットを使用
11
12    Dim record_count As Long
13    record_count = rst_sub1.RecordCount
14
15    If record_count = 0 Then
16        Exit Sub
17    End If
18
19    rst_sub1.MoveFirst
20
21    Dim IsNew As Boolean    '※ 新たに追加する場合
22    
23    Do Until rst_sub1.EOF
24        '※ すでに商品価格マスタへ登録済みか確認
25        IsNew = True
26        rst_sub2.MoveFirst
27        Do Until rst_sub2.EOF
28            If rst_sub2.Fields("商品コード") = rst_sub1.Fields("商品コード") Then
29                IsNew = False
30                Exit Do
31            End If
32            rst_sub2.MoveNext
33        Loop
34        
35        If IsNew = True Then
36            '※ 商品価格マスタに登録が無い場合
37            rst_sub2.AddNew
38            rst_sub2.Fields("商品コード") = rst_sub1.Fields("商品コード")
39            rst_sub2.Update
40        End If
41        
42        rst_sub1.MoveNext
43    Loop
44    
45    '※ 商品価格マスタの再更新
46    sfrm2.Requery
47    
48
49End Sub