VBA 列表框拖放

Question

我正在尝试在 VBA 中生成拖放功能，以允许用户在用户窗体上的列表框之间移动项目。

我遇到的问题是，当您向下单击鼠标按钮并移动鼠标时，列表框选择会在列表中上下移动。我已经设法编写了一些行，当您按下鼠标按钮时捕获选择，因此当您将其拖动到另一个列表框时，正确的项目会被删除，但是我觉得第一个列表框的移动突出显示的选择可能会关闭为最终用户放置。

每次在 MouseMove 事件上移动鼠标时，我都尝试将选择设置为原始项目，但是当光标与列表上的项目对齐时它根本不起作用，但当您移动时它会反弹光标位于列表下方。

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

有人可以阐明如何改进这一点吗？

编辑说明:此示例只会将左侧框中的项目添加到右侧，我计划复制在具有多个列表框的用户窗体上找到的任何解决方案，所以我希望有人知道一个好的机制来实现这一点。

Answer 1

根据 Manish 的评论，this link详细介绍了一个优雅的解决方案，请参阅后面的文章以获取更好的解决方案，该解决方案对用户窗体上的任意数量的列表框都有效。不过，我确实做了一些调整，以使其在我的情况下工作得更好。

用户窗体上除列表框之外的其他控件会引发错误，为了更正此问题，我将 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类中，我添加了以下子项，以便一次只能选择一个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