Listboxda sürükle-birak

[taner3106]

Arkadaslar listbox icindeki verilerin siralamasini sürükle birak yaparak siralamalarini degistirebilir miyiz acaba. Tesekkürlerimi sunuyorum.

 

[veyselemre]

Kodlar http://www.developpez.net/forums/showthread.php?t=121733&page=4 adresinden alıntıdır, nasıl çalıştığı hakkında bir fikrim yok.

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
Effect = 1
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)
Dim place As Integer
Cancel = True
Effect = 1
Me.ListBox1.RemoveItem Me.ListBox1.ListIndex
place = Int(Y / 9) + ListBox1.TopIndex
If place > ListBox1.ListCount Or Y = Null Then place = ListBox1.ListCount '
Me.ListBox1.AddItem Data.GetText, place
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim MyDataObject As DataObject
Dim Effect As Integer
If Button = 1 Then
Set MyDataObject = New DataObject
MyDataObject.SetText Me.ListBox1.Value
Effect = MyDataObject.StartDrag
Else
If Me.ListBox1.ListCount > 0 Then
Me.ListBox1.ControlTipText = "Sürükle Bırak"
End If
End If
End Sub
Private Sub UserForm_Activate()
For t = 0 To 10
ListBox1.AddItem t
Next
End Sub

 

[veyselemre]

Bu kodlarla da listbox1 de listbox2 ye sürükle bırak yöntemiyle veri kopyalanıyor, Microsoft Visual Basic Yardım dan alınmıştır.

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 Long, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
Cancel = True
Effect = 1
End Sub
Private Sub ListBox2_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, 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
ListBox2.AddItem Data.GetText
End Sub
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
Set MyDataObject = New DataObject
Dim Effect As Integer
MyDataObject.SetText ListBox1.Value
Effect = MyDataObject.StartDrag
End If
End Sub
Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem "Choice " _
& (ListBox1.ListCount + 1)
Next i
End Sub

 

[Mahmut Bayram]

işinizi görürür mü acaba
eski bir çalışmam

 

[taner3106]

tesekkür ederim sayin veysel emre. ikinci yazdiginizi denemedim ama ilk yazdiginiz calisiyor.listbox1 deki verileri kendi icinde tasinabiliyor.ama multiselect in degerinin 0 olmasi gerekiyor. 1 veya 2 olursa hata veriyor. listeden coklu secme yapabilmem de gerekiyor tabii oluyorsa. tesekkürler.
ayrica sayin Partner dosyayi zip olarak gönderebilmeniz mümkün mü. Rar olan dosyalari kullanamiyorum. tesekkürler.

 

[Mahmut Bayram]

sayin Partner dosyayi zip olarak gönderebilmeniz mümkün mü. Rar olan dosyalari kullanamiyorum.

 

[osmanfenerli1907]

Merhabalar
Bu sürükleyip bıraktıklarımızı kaydetse.Userformu tekrar açınca sürükleyip bıraktığım gibi açılsa.Bu mümkün müdür?
KOLAY gElSiN

 

[osmanfenerli1907]

Bu mümkün müdür?Sayın arkadaşlar..
Yapmak istediğim başka listboxa sürüklediklerim her zaman orda kalsın userformu açıp kapattığımda dahi..
İYİ GÜNLER

 

[osmanfenerli1907]

sürükle bırak

ii günler
Bu konuda yardımcı olabilir misiniz?
Kolay gelsin.Emeklerinize şimdiden teşekkürler