ログインしてさらにmixiを楽しもう

コメントを投稿して情報交換!
更新通知を受け取って、最新情報をゲット!

Excel VBA 製作所コミュのドラッグ アンド ドロップ

  • mixiチェック
  • このエントリーをはてなブックマークに追加
御世話になります。もし、教えていただければ大変ありがたく存じます。

15個のListBox間で、Dataを自由に相互にドラッグアンドドロップ
させたいと思っています。

また、各々のListBoxへのデータ入力は、Private Sub UserForm_Initialize()
の初期入力の時に、
A列のA2以降のデータを、ListBox1に入力
B列のB2以降のデータを、ListBox2に入力
・・・・・・・
O列のO2以降のデータを、ListBox15に入力 します。

その後、ListBox間でデータのやり取りをドラッグアンドドロップで
行い、その結果をまた、

ListBox1のデータをA列のA2以降に入力
ListBox2のデータをB列のB2以降に入力
・・・・・・・・・
ListBox15のデータをO列のO2以降に入力

と行い、完了させたいと思っています。

JPEGの写真でいいますと、データは緑色のセルにあるA社からU社までを
指します。

モーグさんで、ほぼ私が欲しいサンプルプログラムがあったので、
ListBox1とListBox2間を自由にデータのやり取りするところまで
改造できたのですが、以下項目についてどうやっても達成できない
状況です。
参考にしたアドレスと、私が少しだけ改造したコードを表示致します。

http://www.moug.net/tech/exvba/0150045.htm




Private Sub ListBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

'二番目のリストボックスにマウスが入った時のイベント
'Cancel=TrueでDrag&Drop継続
Cancel = True


End Sub

Private Sub ListBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

'ドラッグ時のみドラッグされたデータをリスト項目に追加
If Action = fmActionDragDrop Then _
ListBox1.AddItem Data.GetText
Data.Clear 'DataObjectのデータクリア



End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim D As DataObject
'マウス左ボタンのドラッグ時に対応
If Button <> 1 Then Exit Sub
'データオブジェクトに現在の選択地を格納
Set D = New DataObject
D.SetText ListBox1.Value
D.StartDrag 'ドラッグ開始



End Sub

Private Sub ListBox2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

'二番目のリストボックスにマウスが入った時のイベント
'Cancel=TrueでDrag&Drop継続
Cancel = True


End Sub



Private Sub ListBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)


'ドラッグ時のみドラッグされたデータをリスト項目に追加
If Action = fmActionDragDrop Then _
ListBox2.AddItem Data.GetText
Data.Clear 'DataObjectのデータクリア




End Sub

Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim D As DataObject
'マウス左ボタンのドラッグ時に対応
If Button <> 1 Then Exit Sub
'データオブジェクトに現在の選択地を格納
Set D = New DataObject
D.SetText ListBox1.Value
D.StartDrag 'ドラッグ開始

End Sub

Private Sub UserForm_Initialize()

Dim lastRow As Long

With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
End With
With ListBox1

.RowSource = "Sheet1!A1:A" & lastRow
End With



End Sub


コメント(1)

古い質問なのでもうすでに解決済みかもしれませんが、解決していないのであれば1点質問です。

> モーグさんで、ほぼ私が欲しいサンプルプログラムがあったので、
> ListBox1とListBox2間を自由にデータのやり取りするところまで
> 改造できたのですが、以下項目についてどうやっても達成できない
> 状況です。

とあるのですが、「以下項目」ってどれですか?

ログインすると、みんなのコメントがもっと見れるよ

mixiユーザー
ログインしてコメントしよう!

Excel VBA 製作所 更新情報

Excel VBA 製作所のメンバーはこんなコミュニティにも参加しています

星印の数は、共通して参加しているメンバーが多いほど増えます。