Question

我试图制作一个Drag＆amp;在VBA中删除功能以允许用户在UserForm上的ListBox之间移动项目。

我遇到的问题是，当您单击鼠标按钮并移动鼠标时，ListBox选项会在列表中上下移动。当你按下鼠标按钮时，我设法编写了一些捕获选择的行，所以当你将它拖到另一个ListBox时，正确的项目会被删除，但是我觉得第一个ListBox的移动突出显示的选择可能不要为最终用户投入使用。

我每次在MouseMove事件上移动鼠标时都尝试将选择设置为原始项目，但是当光标与列表中的项目一致时它根本不起作用，但它确实会在将光标移动到列表下方。

Here's a copy of the macro workbook (Excel 2010)

任何人都可以对如何改进这一点有所了解吗？

编辑注释：此示例只会向左侧框中添加项目，我计划在具有多个ListBox的UserForm上复制此处找到的任何解决方案，所以我希望有人知道有一个很好的机制来实现这一点。 / p>

Answer 1

根据Manish的评论，this link详细说明了一个优雅的解决方案，请查看后面的文章，了解更好的解决方案，它对UserForm上的任意数量的ListBox都有效。我做了一些调整，以使其在我的情况下更好地工作。

UserForm上的其他控件引发的错误不是ListBox，为了纠正这个问题，我将UserForm_Initialize()更改为：

Private Sub UserForm_Initialize()
    Dim Ctrl As MSForms.Control
    Dim LMB As ListBoxDragAndDropManager
    Dim x As Integer

    Set LBs = New Collection
    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "ListBox" Then
            Set LMB = New ListBoxDragAndDropManager
            Set LMB.ThisListBox = Ctrl
            LBs.Add LMB
        End If
    Next
End Sub

在ListBoxDragAndDropManager类中，我添加了以下sub，以便一次只能选择一个ListBox，这使得UserForm在使用中看起来更好看，但在功能上没有任何区别：

Private Sub pThisListBox_Click()
    Dim Ctrl As MSForms.Control
    Dim i As Integer

    For Each Ctrl In ThisListBox.Parent.Controls
        If Ctrl.Name <> ThisListBox.Name And TypeName(Ctrl) = "ListBox" Then
            For i = 0 To Ctrl.ListCount - 1
                Ctrl.Selected(i) = False
            Next i
        End If
    Next Ctrl
End Sub

Answer 2

使用列表框MouseMove、BeforeDragOver 和BeforeDropOrPaste 事件，我在列表框（Listbox1 和Listbox3）之间执行拖放。如果要移动的列表框项已经存在于另一个列表框中，则 msgbox 会警告用户并且不会执行移动。

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim OurDataObject As DataObject
    If Button = 1 Then
        On Error Resume Next
        Set OurDataObject = New DataObject
        Dim Effect As Integer
        OurDataObject.SetText ListBox1.Value
        Effect = OurDataObject.StartDrag
    End If
End Sub

Private Sub ListBox3_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
Effect = 1
End Sub

Private Sub ListBox3_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)
Cancel = True
Effect = 1
...
ListBox3.AddItem Data.GetText
End Sub

此处的详细信息和示例文件：Excel Vba listbox drag & drop

Answer 3

类模块可用于列表框拖放：

Private Sub ListBox1_MouseMove(ByVal Button As _
     Integer, ByVal Shift As Integer, ByVal X As _
     Single, ByVal Y As Single)
    Dim MyDataObject As DataObject
    If Button = 1 Then
        On Error Resume Next
        Set MyDataObject = New DataObject
        Dim Effect As Integer
        MyDataObject.SetText ListBox1.Value
        Effect = MyDataObject.StartDrag
    End If
End Sub

Answer 4

这是一个非常优雅的解决方案： create and specify a custom runtime

它描述了如何以VBA形式从一个列表框拖动到另一个列表框。我发现它在EXCEL表单环境中可以正常工作。

VBA Listbox Drag＆amp;降

4 个答案: