コンボボックスのリストのテーブルからの直接取得の方法

質問

下記の件に関しご教授願います。

Excelで、コンボボックスのデータ取得を、ワークシートに書き出してからそれをListFillRange等で行っていましたが、レコードセットしたテーブルのデータを直接取得することは出来ないでしょうか。

RowSourceType = "Field List"等試してみましたがわかりませんでした。もしExcelで出来るようでしたらお教えください。

Dim objcon As ADODB.Connection
Dim objrs As ADODB.Recordset
Dim i As Integer

Set objcon = New ADODB.Connection
Set objrs = New ADODB.Recordset

objcon.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\process.mdb"

Dim code As Variant
Dim mmcode As Variant

mmcode = Worksheets("入力sheet").Range("d100").Text

code = "'" & mmcode & "%'" '

With objrs
.ActiveConnection = objcon
.Source = "select 顧客名 from 002顧客名 where 県名 like " & code & ";"
.Open
End With

ここから、ワークシートに書き出してましたが、コンボボックスのリストに直接指定したいのです。

下記の方法で試しましたが、浅い知識ではうまくいきませんでした。
ComboBox4.RowSourceType = "field list"
ComboBox4.RowSource = objrs
何か方法があればお教えください。

回答No.3

KenKen_SP · ベストアンサー

こんにちは。

試しに、下記手順を行って下さい。

1.　process.mdb と同じフォルダ内に新規ブックを作成
2.　シート名を [入力sheet] に変更
3.　D110 セル付近に ComboBox を一つ書き込む
　　※[表示]-[ツールバー]-[コントロール ツールボックス]から
4.　ワークシート"入力sheet" モジュールに下記ソースをコピペ

以上。

' 場所： ワークシート"入力sheet" モジュール

Option Explicit

Private Const MDB_NAME = "process.mdb" ' MDB ファイル名

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim Sql　 As String
　　Dim sCode As String

　　' 値が変化したセルが D100 だったら実行
　　If Target.Address = "$D$100" Then
　　　　' 県名コード取得
　　　　sCode = Me.Range("D100").Text
　　　　' Sql 生成
　　　　Sql = ""
　　　　Sql = Sql & "SELECT [顧客名]"
　　　　Sql = Sql & " FROM [002顧客名]"
　　　　If sCode = "" Then
　　　　　　Sql = Sql & ";" ' 全件出力
　　　　Else
　　　　　　Sql = Sql & " WHERE [県名] LIKE '" & sCode & "%';"
　　　　End If
　　　　' コンボボックスにデータ追加
　　　　Call ComboBoxAddItem(Sql)
　　End If

End Sub

' コンボボックスにアイテムを追加します
Private Sub ComboBoxAddItem(ByVal Sql As String)

　　Dim Cn　　　As ADODB.Connection
　　Dim Rs　　　As ADODB.Recordset
　　Dim sConStr As String

　　' MDB 接続文字列 -----------------------------------------------
　　sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" _
　　　　　　& "Data Source=" & ThisWorkbook.Path & "\" & MDB_NAME
　　'---------------------------------------------------------------
　　Set Cn = New ADODB.Connection
　　Set Rs = New ADODB.Recordset
　　' DB 接続を開く
　　Cn.Open sConStr
　　' 読み取り専用でレコードセットを作成
　　Rs.Open Sql, Cn, adOpenStatic, adLockReadOnly
　　' ComboBox に追加
　　Me.ComboBox1.Clear
　　If Not Rs.EOF Then
　　　　Rs.MoveFirst
　　　　While Not Rs.EOF
　　　　　　Me.ComboBox1.AddItem Rs![顧客名]
　　　　　　Rs.MoveNext
　　　　Wend
　　　　Rs.Close: Set Rs = Nothing
　　End If
　　Cn.Close: Set Cn = Nothing

End Sub

お礼

ご回答ありがとうございます。
こちらはまだうまくいかないのですが、推測とヘルプ参照だけでは、対応出来ないレベルのようで、ＶＢＡのデータベース関連の所を今勉強中です。いま少し時間を下さい。

回答No.2

KenKen_SP

#1 補足について

Excel VBA の話ですよね？

コントロール名はご自分のものに合わせて下さい。
それから、該当データが１件も無い場合の例外処理も必要ですよ。

ComboBox とはユーザーフォーム上ですか？ それともワークシート上に
[表示]-[ツールバー]-[コントロール ツールボックス]で書いたものですか？

補足

御返事ありがとうございます。
ComboBoxは、ワークシート上に書いたものです。
ＶＢＡは、標準モジュールでなく、Worksheets("入力sheet")に書いてます。
宜しくお願いいたします。

回答No.1

KenKen_SP

こんばんは。KenKen_SP です。

Excel の ComboBox なら AddItem するとか。

ComboBox1.Clear
objrs.MoveFirst
While Not objrs.EOF
　　ComboBox1.AddItem Rs![顧客名]
　　objrs.MoveNext
Wend

試してないし、回答はコピペではなく直打ちなので若干ミスがあるが
あるかもしれませんが、こんな感じです。

AddItem 以外ではご質問にあるとおり、セル経由の ListFillRange を
使うか、レコードセットの内容を一度配列にしまって List を使います。

が、、これは「同一内容を別の場所にコピー」するという点でともに
効率の悪い方法ですから最初から AddItem すると良いと思います。

補足

御返事遅れ大変失礼しました。
試してみたのですが、
１行目で
ComboBox1.Clear
（予期せぬエラー）
が発生、その後１行目を削除して動かしたら

objrs.MoveFirst
While Not objrs.EOF
　　ComboBox1.AddItem Rs![顧客名]
　　（オブジェクトが必要です）
と、ここでエラーメッセージがでます。
いろいろ試したのですが、うまくいきませんでした。
追加アドバイスをお願いいたします。