リストボックスから複数行を選択し、その複数のデータをセルに入力したい

質問

Excel2003でマクロをつくっています。シートのＢ列を右クリックすると、リストボックスが表示され　任意１行を選択するとシートのＢ列、Ｃ列、Ｄ列のセルにデーターが入力されます。

Private Sub ListBox2_Click()
With ListBox2
If .ListIndex = -1 Then
MsgBox "項目を選択してくだい"
Else
’シートが保護されていたら保護を解除
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect
End If
ActiveCell.Value = ListBox2.List(ListBox2.ListIndex, 0)
ActiveCell.Offset(0, 1).Value = ListBox2.List(ListBox2.ListIndex, 1)
ActiveCell.Offset(0, 2).Value = ListBox2.List(ListBox2.ListIndex, 2)
ActiveSheet.Protect
End If
End With
Unload UserForm3
End Sub

このリストボックスから複数の行を選択し、シートのＢ列、Ｃ列、Ｄ列のセルにデーターを入力したいのですが、Multiselectプロパティを変更しても、一行のみしか入力できません。
上のコードをどうかえたらよろしいでしょうか。

回答No.4

pulsa · ベストアンサー

実行できなかったというのは、どこができなかったのでしょう？
リストボックスの表示自体ができなかったと言う事なのかな？

…仕方ない
乗りかかった船だべ

これをThisWorkBook（VBEのシートの下にあるモジュールですよ）に書きます
Option Explicit

Private Sub Workbook_Open()
　　Dim Newb
　　Set Newb = Application.CommandBars("Cell").Controls.Add()
　　With Newb
　　　　.Caption = "出でよ！リストボックス"
　　　　.OnAction = "AddMyListBox"
　　　　.BeginGroup = False
　　End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Application.CommandBars("Cell").Controls("出でよ！リストボックス").Delete
End Sub

これを標準モジュールに書きます
Option Explicit

Sub AddMyListBox()
　　Dim MyList
　　Set MyList = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", _
　　　　 Left:=90, Top:=127.5, Width:=72, Height:=72) 'リストボックス宣言
　　With MyList
　　　　.ListFillRange = "A1:A10"'リストの項目
　　　　.Locked = True
　　End With
End Sub

これでセルの右クリックでリストボックスが出せるハズです
プロパティは、表示されたリストボックスを右クリックでプロパティを表示させ、左の列の項目を上のWithに追加します
あとは、No.1さんのや、前回の俺が提示したロジックを改造すれば、貼り付け部分は何とかなるでしょう

今回のような、したい事にたどり着く為に乗り越えなきゃならない事が複数あるときは、それを個別に質問すると、そのものズバリの返答ができるので、結果的にお互い楽です
なので、今回の場合は
まず質問タイトルは、
『右クリックでシート上にリストボックスを表示したい』
で、出し方を聞いて
貼り付け方は別に質問を立てた方が、良かったように思いますよ
最初の内はしたい事が先行してしまうのは、判らなくないですけど＾＾；

しっかし、初心者にはなまらハードル高いべや、コレ・・・

お礼

父の死亡によりお礼が遅くなりもうしわけありません。あなたのいうとおりやったら。できました。ありがとうございました。

回答No.3

pulsa

初心者と言っても、どの辺から説明すれば良いのか判らない為、なるべく質問内容にのみ返答するようにしています
あれこれ言っても混乱するでしょうしね

このマクロはお伺いの部分以外にも問題を抱えています
クリック=選択　ですが
このマクロはその他に、入力開始の合図を兼用しています
動作としては、例えば
1行目選択→1行目の内容を入力
2行目選択→1行目の内容を入力+2行目の内容を入力
この時1行目の入力は無駄です
普通しません
なので、No.1さんはダブルクリックを入力開始の合図にしてます

また、ActiveCellを使用し、複数選択されていたときの動作を指定していない為、常に同じセルに書き込みに行きます
この為、1行のみしか、結果的に入力されているように見えません

補足の件ですが
すいません
ListBox2.ListIndex(i)=True
は、Multiselectでは使えませんね
自分で言っておきながら何を言ってるんだか

考え方としては、リストボックスのリスト項目をループして
ListBox2.Selected(iCnt) = True
のとき、選択されていたときの動作に入るようにします
が正解です
If ListBox2.Selected(iCnt) = True Then
として選択されているかどうかの判定に使用します

以上を踏まえコードを表示します
動作をダブルクリックで入力開始します
複数選択されていたときは、ActiveCellの下に追加して書き出します
最後リストボックスを削除していますので、リストボックスを最初に作成する時に、プロパティの設定をマクロで行っている必要があります

Option Explicit

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　Dim iCnt As Integer
　　Dim iMax As Integer
　　Dim jCnt As Integer

　　jCnt = 0　　　　　　　　　　　　'初期化
　　iMax = ListBox2.ListCount - 1 'ListIndexが0からの為
　　For iCnt = 0 To iMax
　　　　If ListBox2.Selected(iCnt + 1) = True Then '該当行が選択されていたら
　　　　　　ActiveCell.Offset(jCnt, 0).Value = ListBox2.List(iCnt, 0)
　　　　　　ActiveCell.Offset(jCnt, 1).Value = ListBox2.List(iCnt, 1)
　　　　　　ActiveCell.Offset(jCnt, 2).Value = ListBox2.List(iCnt, 2)
　　　　　　jCnt = jCnt + 1
　　　　End If
　　Next iCnt
　　ActiveSheet.Shapes("ListBox2").Delete
End Sub

変数などは違いますが、やっている事はNo.1さんと同じです
最後にFilListRangeは確かにありません
ListFillRangeだと思われます

補足

ご回答ありがとうございます。
せっかく、ご指導いただきながら、能力不足のためマクロ実行できませんでした。申し訳ありません。たぶんリストボックスを貼り付けしてないからだとおもわれます。、ユーザーフォーム上に リストボックスをつける方法をあるサイトで見つけました。自分のやりたい事にもっとも近いのですが、これもまたうまく作動できません。情けなかです。

Dim r '行位置を格納しておくフォームレベルの変数
Dim c '列位置を格納しておくフォームレベルの変数

Private Sub ListBox1_Click()
' List([行位置],[列位置])
' 列、行位置ともに 0から始まります。例えば、１行目の２列目を
' 表すときは List(0,1) と記述します。
Dim aSelect() As Variant
Dim i 'リストボックスの列を表す変数

With ListBox1
ReDim aSelect(1 To .ColumnCount)
For i = 1 To .ColumnCount
aSelect(i) = .List(.ListIndex, i - 1)
Next i
End With
With ActiveSheet
.Range(.Cells(r, 7), .Cells(r, 7 + ListBox1.ColumnCount - 1)) = aSelect
End With
'行位置カウンタを +1しておく
r = r + 1
End Sub

Private Sub UserForm_Initialize()

' ListBox1の表示データを作成する
For r = 1 To 10
For c = 1 To 3
Cells(r, c) = Cells(r, c).Address
Next
Next
' ListBox1の表示設定
ListBox1.ColumnCount = 3
ListBox1.RowSource = "Sheet1!A1:C11"
'フォーム表示時に基準行位置を設定しておく
r = 10
End Sub

回答No.2

pulsa

ヘルプに
>リスト ボックス (ListBox) コントロールで、MultiSelect プロパティを使って複数選択を許可している場合、選択されている行を調べるには、ListIndex プロパティの代わりに Selected プロパティを使います。
とあります

考え方としては、リストボックスのListIndexをループして
ListBox2.ListIndex(i)=True
のとき、選択されていたときの動作に入るようにします

さほど難しくないと思いますので、コードはつけません（No.1さんが書いてますし）
何か問題あれば、補足して下さい

補足

超初心者の自分。ＶＢＡのいろんな参考書を本屋でみましたが、複数行を選択するコードばかりで、それをセルに書き込むコードが見当たりません。表示させるだけで意味があるのでしょうか。不思議です。

回答No.1

imogasi

シートにコントロールツールボックスのリストボックスを１つ張り付け。プロパティのFilListRangeはＧ１：Ｇ１０
りんご
いちご
バナナ
みかん
パイナップル
キウイ
イチジク
ーー
ダブルクリックイベントに
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
j = 1
d = Range("a65536").End(xlUp).Row
For 選択行 = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(選択行) Then
x = ListBox1.List(選択行, 0)
Cells(d + 1, j) = x
j = j + 1
End If
Next 選択行
End Sub
ーーー
使い方
いちご、キウイ、イチジクを選択する場合
いちごをクリック、キウイをクリック、最後にイチジクをダブルクリック
ーーー
それでシートには
いちご バナナ キウイ
りんご
りんご バナナ パイナップル
いちご キウイ イチジク　　　＜－－－
の最後の行のようになる。

補足

ご回答ありがとうございます。
シートにコントロールツールボックスのリストボックスを１つ張り付け・・・・・貼り付けでなく、シートのＢ列を右クリックするとリストボックスがあらわれる仕様にしたいです。
プロパティFilListRange　が表示されません。ヴァージョンが違うかも・・・