アクセスにて検索フォームを作りたい

質問

お世話になります。
アクセス初心者です。

会社名検索フォームに会社名を入力して表示コマンドをクリックすると
会社フォームの入力した会社が表示されるようにしたいのです。

現在は、表示コマンドをクリックすると会社フォームが開きます。
どの会社名を打ち込んでもNo.1のレコードしか開きません。
つまり会社フォームが開く　という指示をしているだけです。

コードなど全く分かりません。
ただ、本を見て真似て下記の通り入力してみました。
間違っているor足りない　ということはわかっていますが、
どう入力すれば良いのかわかりません。
教えて下さい。よろしくお願いいたします。

Private Sub cmd表示_Click()
On Error GoTo Err_cmd表示_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "会社フォーム"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmd表示_Click:
Exit Sub

Err_cmd表示_Click:
MsgBox Err.Description
Resume Exit_cmd表示_Click

End Sub

回答No.2

noname#22222 · ベストアンサー

＜会社一覧＞
ID　　　会社名　住所
1　　　　AAA　　東京
2　　　　BBB　　大阪
3　　　　CCC　　京都

というテーブルがあって

＜会社一覧を表示する[会社フォーム]＞。
＜特定の会社情報を参照するフォーム＞。

後者には、参照すべき会社名を入力する[会社名]というテキストボックス。
更に、[会社フォーム]をオープンするコマンドボタン。

さて、コマンドボタンを配置すると、＜コマンドボタンウィザード＞が開きます。

・[フォームの操作]-[フォームを開く]。
・[会社フォーム]を選択。
・[特定のレコードを選択]を選択。
・[関連付けるフィールド]を[会社名<->会社名]にする。

この手順で、次のようなコードが生成されます。

Private Sub コマンド_会社情報参照_Click()
On Error GoTo Err_コマンド_会社情報参照_Click

　　Dim stDocName As String
　　Dim stLinkCriteria As String

　　stDocName = ChrW(20250) & ChrW(31038) & ChrW(12501) & ChrW(12457) & ChrW(12540) & ChrW(12512)

　　stLinkCriteria = "[会社名]=" & "'" & Me![会社名] & "'"
　　DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_コマンド_会社情報参照_Click:
　　Exit Sub

Err_コマンド_会社情報参照_Click:
　　MsgBox Err.Description
　　Resume Exit_コマンド_会社情報参照_Click

End Sub

冗長なコードですので次のように修正します。

Private Sub コマンド_会社情報参照_Click()
On Error Resume Next
　　DoCmd.OpenForm "会社フォーム", , , "[会社名]=" & "'" & Me![会社名] & "'"
End Sub

さて、この場合、'AAA' と入力しないと表示されないという不便さがあります。
LIKE文を利用する手もあります。（ワイルドカードは * かも知れません！）
これですと、'A'だけでも表示されます。

Private Sub コマンド_会社情報参照_II_Click()
On Error Resume Next
　　If Len(Me.会社名 & "") > 0 Then
　　　　DoCmd.OpenForm "会社フォーム", , , "[会社名] LIKE " & "'" & Me![会社名] & "%'"
　　Else
　　　　MsgBox "先に、会社名を入力して下さい。"
　　End If
End Sub

次は、「フィルター機能もありますよ」という例示です。

Private Sub コマンド_会社情報参照_II_Click()
On Error Resume Next
　　If Len(Me.会社名 & "") > 0 Then
　　　　DoCmd.OpenForm "会社フォーム"
　　　　Forms("会社フォーム").Filter = "[会社名] LIKE " & "'" & Me![会社名] & "%'"
　　　　Forms("会社フォーム").FilterOn = True
　　Else
　　　　MsgBox "先に、会社名を入力して下さい。"
　　End If
End Sub

お礼

どうもありがとうございます。
コードを打ち込まなくても良い簡単な方法を教えて下さり、とてもうれしいです。
やはり初心者ですから、なるべく簡単な方法を知りたいです。
また、応用バージョンまで教えて下さって本当にありがとうございました。

回答No.1

mshr1962

Private Sub cmd表示_Click()
On Error GoTo Err_cmd表示_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "会社フォーム"

'下記の1行が抜けてます。フィールド名が違う場合は訂正して下さい
stLinkCriteria　="[会社名]=" & "'" & Me![会社名] & "'"
'
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmd表示_Click:
Exit Sub

Err_cmd表示_Click:
MsgBox Err.Description
Resume Exit_cmd表示_Click

End Sub

お礼

どうもありがとうございます。
抜けている所をわかりやすく指摘して下さり、
初心者の私でも付け足す箇所がすぐにわかりました。