VBA列表框拖放

我試圖產生一個拖動&在VBA中拖放功能以允許用戶在用戶窗體上的列表框之間移動項目。VBA列表框拖放

我遇到的問題是，當你點擊鼠標按鈕和移動鼠標，列表框選擇和上下移動列表。我已經設法寫了一些行來捕獲選擇，當你按下鼠標按鈕時，所以當你將它拖到另一個ListBox時，正確的項目被刪除，但是我感覺到第一個ListBox的移動高亮選擇可能關閉投放給最終用戶。

我試圖每次在MouseMove事件上移動鼠標時都將設置選項設置爲原始項目，但當光標與列表中的項目一致時，它根本不起作用，但它確實會在您回彈時返回將光標移動到列表下方。

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

誰能照亮如何可以改善一些輕？

編輯說明：這個例子只會將項目從左邊的框中添加到右邊，我打算在多個ListBox中複製UserForm中找到的任何解決方案，所以我希望有人知道一個好的機制來實現這一點。

來源

2016-07-01 Carrosive

爲什麼不在兩個框之間添加按鈕並編寫代碼將選定的項從一個框移動到另一個框？像這樣[** one **]（http://www.contextures.com/excelvbalistboxmoveuserform.html）。 – ManishChristian

@ManishChristian爲了討論起見，這是一個瘦身的例子，我想到的實際使用是一個帶有多個框的表單，其中多個按鈕用於交換它們之間的項目都可能變得非常麻煩。 – Carrosive

查看[** this **]（http://www.mrexcel.com/forum/excel-questions/446895-need-help-code-drag-drop.html）鏈接。 – ManishChristian

根據Manish的評論，this link詳細介紹了一個優雅的解決方案，請看後面的文章，以獲得對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類添加以下子，以便只有一個列表框可以一次選擇，它使用戶窗體的外觀，在使用更好，但不做出任何的功能差異：

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

來源

2016-07-04 10:35:11 Carrosive

-1

類MODUL可用於列表框拖拽：

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

來源

2016-10-24 19:30:16 kadrleyn

VBA列表框拖放

回答

相關問題