| |
▼遠藤 さん：
こんばんは。
>VBA初心者です。教えてください。
>ボタンと複数選択可のリストボックスが2個あって1個目に選択されたデータを、ボタンをクリックすると2個目のリストボックスに選択されているデータが表示されるようにしたいと思っています。どのようにしたらよいでしょうか？
>また、1個目に表示されるデータは、セル範囲の値でなければいけませんか？
>アクセスのテーブルを指定はできませんでしょうか？
>よろしくお願いします。
これって、ユーザーフォームでの話ですよね。そうだと思って考えました。
尚、コントロールについては、シートに貼り付けたものとかフォーム上のとか書いていただけると助かるんで、よろしくお願いします。
テーブルを直接指定は出来なかったと思いますので、一度テーブルのデータをセルに落としてから処理する方法ですが。
仕様:
ユーザーフォーム（Userform1）
リストボックスが二つ（Listbox1、Listbox2
共にマルチセレクトで設定）
コマンドボタンひとつ（Commandbutton1）
Mdbファイル（"listboxに反映させる.mdb")
テーブルひとつ（"tbl_sample")
フィールドは二つ（数値型の主キー「id」とテキスト型「list_data」）をサンプルとしました（list_dataをリストボックスに表示させるようにしました）。
まず、標準モジュール（Module1）にMdbファイルのI/Oプロシジャー
'=========================================================
Dim cn As New ADODB.Connection
'============================================
Sub open_db(dbpath As String)
'データベースオープン
On erroro GoTo err_open_db
cn.ConnectionString = "provider=Microsoft.jet.OLEDB.4.0;" & "Data Source=" & dbpath
cn.Open
On Error GoTo 0
Exit Sub
err_open_db:
MsgBox Error(Err.Number) & Err.Number
Stop
End Sub
'=========================================
Sub close_db()
'データベースクローズ
On Error Resume Next
cn.Close
On Error GoTo 0
End Sub
'===========================================================
Function get_rs(sql As String, rs As ADODB.Recordset) As Long
'レコードセットの取得
On Error GoTo err_get_rs
get_rs = 0
rs.Open sql, cn, adOpenStatic, adLockOptimistic
If rs.EOF = True Then
get_rs = 1
End If
ret_get_rs:
On Error GoTo 0
Exit Function
err_get_rs:
MsgBox Error(Err.Number) & Err.Number
get_rs = Err.Number
Resume ret_get_rs
End Function
'=====================================
Sub close_rs(rs As ADODB.Recordset)
'レコードセットのクローズ
On Error Resume Next
rs.Close
On Error GoTo 0
End Sub
別の標準モジュール（Module2）には、フォームの表示のコード
'======================================================
Sub main()
UserForm1.Show
End Sub
最後に当該フォームモジッュール
'==========================================================
Dim rs As New ADODB.Recordset
'=========================================
Private Sub UserForm_Initialize()
Dim dbnm As String
Dim sqlstr As String
dbnm = ThisWorkbook.Path & "\listboxに反映させる.mdb"
Call open_db(dbnm)
sqlstr = "select * from tbl_sample;"
If get_rs(sqlstr, rs) = 0 Then
With ThisWorkbook.Sheets(1)
.Range("a1").CopyFromRecordset rs
'Ａ列にid、Ｂ列にlist_dataがコピーされます
ListBox1.RowSource = Range(Cells(1, 2), Cells(rs.RecordCount, 2)).Address
ListBox1.ListIndex = 0
End With
Call close_rs(rs)
End If
Call close_db
End Sub
'====================================================================
Private Sub CommandButton1_Click()
ListBox2.Clear
With ListBox1
For idx = 0 To .ListCount - 1
If .Selected(idx) = True Then
ListBox2.AddItem .List(idx)
End If
Next
End With
End Sub
以上ですが､ADOを使用していますので、
参照設定で「Microsoft ActiveX Data Objects X.X Library」をチェックしてください。
|
|
ichinose
- 03/4/17(木) 21:25 -
