Accessで、入力内容に応じたリスト参照をしたい

質問

いつも大変お世話になっております。m(＿ ＿)m
質問させてください。

Accessで、入力内容に応じてあるフィールドで参照するリストを変更させたいのですが、難しい設定や記述が必要でしょうか？

マスタテーブルに以下の情報を入れておきます
品名／値段
Ａ・・・１００円
Ａ・・・２００円
Ｂ・・・３００円
Ｂ・・・４００円

次に、別のテーブルを作成します
そのテーブルには、「品名」「値段」を入力するわけですが
「値段」のフィールドには、リストボックス（またはコンボボックス）を設定しておき、「品名」を「Ａ」と入れたら、「値段」のフィールドでリストボックスに表示される選択肢を「１００円と２００円」
品名を「Ｂ」と入力したら、リストボックスの選択肢は「３００円と４００円」というように、入力する値によって瞬間的に参照する値を変更したいのですが、可能でしょうか？

できるだけ具体的に回答をお願いします。
お手数おかけします。よろしくお願いします。

回答No.4

venzou

>「このフォームまたはレポートで指定されているレコードソース・・・・は存在しません」というメッセージが出てうまくいきません。

テストデータを作って確認しましたが、こちらでは正常でした。
（コンボボックスと、リストボックスの両方でテスト、Access2000）

原因が分からないので、とりあえず、

Private Sub 品名_AfterUpdate()
　debug.print "SELECT 値段 FROM マスタテーブル WHERE 品名='" & [品名] & "'"
End Sub

などで、SQL文の内容を出力して、正常か確認してみてください。
（もしよろしければ、この部分のソースと、出力されるSQL文を補足してください。）

また、そのSQL文を元にクエリを作ってみて、
レコードが選択できているか、確認してみてください。

SQL文からクエリを作るのは、
クエリを新規作成し、テーブルは追加せず、
[表示]→[SQLビュー]にして、SQL文を直接記述します。

回答No.3

venzou

＃１さんとほぼ同じですが・・・

値段コンボボックスの「値集合タイプ」を「テーブル/クエリ」にすれば、
SQL文を直接入れることが出来ます。

Private Sub Form_Current()
　　If Not Me.NewRecord Then
　　　　Me.値段.RowSource = "SELECT 値段 FROM マスタテーブル WHERE 品名='" & [品名] & "'"
　　End If
End Sub

Private Sub 品名_AfterUpdate()
　　Me.値段.RowSource = "SELECT 値段 FROM マスタテーブル WHERE 品名='" & [品名] & "'"
　　If DCount("*", "マスタテーブル", "品名='" & [品名] & "' AND '' & 値段='" & Me.値段 & "'") = 0 Then
　　　　Me.値段.Value = Me.値段.ItemData(0)
　　End If
End Sub

注：DCount関数は、＃１の回答にある、DBCount関数ではありません。
名前も機能も似てますが、こちらは標準の関数です。

お礼

お返事が遅くなってすみません。
上記の方法を試してみましたがうまくいきません。
テーブルの「値集合タイプ」を「テーブル／クエリ」にし、「値集合ソース」に上記の記述をし、該当するテーブル名・フィールド名等に変更したのですが、品名を入力し、コンボボックスを参照しようとすると、
「このフォームまたはレポートで指定されているレコードソース・・・・は存在しません」というメッセージが出てうまくいきません。
方法がまずかったのでしょうか？
お手数おかけします。再度教えていただけると助かります。

回答No.2

noname#140971

さて、僅か７行程度で目的を実現するプログラムコードを書くには、諸手続きを関数化することです。
次は、そういう目的を持って作成した DBSelect関数とDBCount関数です。

Public Function DBSelect(ByVal strQuerySQL As String) As String
On Error GoTo Err_DBSelect
　　Dim I　　 As Integer
　　Dim J　　 As Integer
　　Dim R　　 As Integer
　　Dim C　　 As Integer
　　Dim M　　 As Integer
　　Dim N　　 As Integer
　　Dim rst　 As ADODB.Recordset
　　Dim fld　 As ADODB.Field
　　Dim Datas As String

　　Set rst = New ADODB.Recordset
　　' =================
　　'　Begin With: rst
　　' -----------------
　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　' --------------
　　　　　　'　配列を再宣言
　　　　　　' --------------
　　　　　　M = .RecordCount - 1
　　　　　　N = .Fields.Count - 1
　　　　　　' ------------------------------------
　　　　　　'　列情報を For-Next で配列に代入する
　　　　　　' ------------------------------------
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　For C = 0 To N
　　　　　　　　　　Datas = Datas & .Fields(C) & ";"
　　　　　　　　Next C
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = Datas
　　Exit Function
Err_DBSelect:
　　M = 0
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

Public Function DBCount(ByVal strField As String, _
　　　　　　　　　　　　ByVal strTable As String, _
　　　　　　　　　　　　Optional ByVal strWhere As String = "") As Variant
On Error GoTo Err_DBCount
　　 Dim N
　　 Dim strQuerySQL As String
　　 Dim rst　　　　 As ADODB.Recordset

　　 Set rst = New ADODB.Recordset
　　 strQuerySQL = "SELECT COUNT(" & strField & ") FROM " & strTable
　　 If Len(strWhere) > 0 Then
　　　　 strQuerySQL = strQuerySQL & " WHERE " & strWhere
　　 End If
　　 With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　 .MoveFirst
　　　　　　 N = Nz(.Fields(0), 0)
　　　　 End If
　　 End With
Exit_DBCount:
On Error Resume Next
　　 rst.Close
　　 Set rst = Nothing
　　 DBCount = N
　　 Exit Function
Err_DBCount:
　　 MsgBox "SELECT 文の実行時にエラーが発生しました。(DBCount)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　 Resume Exit_DBCount
End Function

お礼

お返事が遅くなりまして申し訳ありませんでした。
懇切丁寧な回答、本当にありがとうございました。
まだ成功したわけではありませんが・・・
挑戦してみます。

回答No.1

noname#140971

丸投げの質問はルール違反です。
多少、丸投げ臭いですよ。

さて、ここでは、コンボボックスを利用する例を示します。

＜価格リスト＞
ID_____品名___値段
1______A________\100
2______A________\200
3______B________\300
4______B________\400

ところで、DBSelect関数をイミディエイトウィンドウでテストしてみましょう。

[イミディエイト]
? DBSelect("SELECT 値段 FROM 価格リスト WHERE 品名='A'")
100;200;
? DBSelect("SELECT 値段 FROM 価格リスト WHERE 品名='B'")
300;400;

DBSelect関数は、正に、コンボボックスのリスト列を戻す関数として作成されていることが判ります。

＜注文履歴＞

ID___受注日_________品名____値段
1_____007/05/10___A_________\100

この注文履歴テーブルを基に単票入力フォームを作成し[値段]をコンボボックスで選択するとします。
この場合、(1)既入力レコード対策、(2)[品名]更新後処理に関わるコードを書く必要があります。
(2)では、更に、候補と入力されている値段との矛盾チェックも必要となります。

Option Compare Database
Option Explicit

Private Sub Form_Current()
　　If Not Me.NewRecord Then
　　　　Me.値段.RowSource = DBSelect("SELECT 値段 FROM 価格リスト WHERE 品名='" & [品名] & "'")
　　End If
End Sub

Private Sub 品名_AfterUpdate()
　　Me.値段.RowSource = DBSelect("SELECT 値段 FROM 価格リスト WHERE 品名='" & [品名] & "'")
　　If DBCount("*", "価格リスト", "品名='" & [品名] & "' AND 値段=" & Me.値段) = 0 Then
　　　　Me.値段.Value = Me.値段.ItemData(0)
　　End If
End Sub

さて、そういう訳で、７行程のプログラムコードを書けば目的を実現できるでしょう。

※DBSelect関数、DBCount関数を用意しなければならないことは言うまでもありません。
※長くなりますので、この関数は別途補足します。

お礼

「丸投げ」すみません。（＾＾；）
自分の中では丸投げのつもりはなかったのですが、素人なものでスミマセン。
回答ありがとうございました。挑戦してみます。
やってみて不明点がありましたら、補足させていただくと思います。
よろしくお願いします。