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)
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)
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