Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13518 / 13646 ツリー ←次へ | 前へ→

【5012】リストボックスの件 遠藤 03/4/17(木) 12:54 質問
【5026】Re:リストボックスの件 ichinose 03/4/17(木) 21:25 回答
【5043】Re:リストボックスの件 遠藤 03/4/18(金) 18:45 お礼

【5012】リストボックスの件
質問  遠藤  - 03/4/17(木) 12:54 -

引用なし
パスワード
   VBA初心者です。教えてください。
ボタンと複数選択可のリストボックスが2個あって1個目に選択されたデータを、ボタンをクリックすると2個目のリストボックスに選択されているデータが表示されるようにしたいと思っています。どのようにしたらよいでしょうか?
また、1個目に表示されるデータは、セル範囲の値でなければいけませんか?
アクセスのテーブルを指定はできませんでしょうか?
よろしくお願いします。

【5026】Re:リストボックスの件
回答  ichinose  - 03/4/17(木) 21:25 -

引用なし
パスワード
   ▼遠藤 さん:
こんばんは。
>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
     'A列にid、B列に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」をチェックしてください。

【5043】Re:リストボックスの件
お礼  遠藤  - 03/4/18(金) 18:45 -

引用なし
パスワード
   有難うございます。
難しそうですがやってみます。

13518 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free