Textbox

[Costcost]

Merhabalar,

Userform üzerinde 1 listview ve 100'e yakın textbox bulunmakta. listview'e kayıt ettiğim verileri, textbox'a sürükleyerek bırakıyorum. textbox'a bıraktığım veriyi tekrar mouse'la başka textbox'a sürükle bırak yöntemiyle hallediyorum. sorunum ise, textbox'tan textbox'a veriyi sürüklediğimde verinin değişmesi. örnek olarak, 50. textboxtaki veriyi listview 6.satırından aldım sürükle bırakla. 50.textbox'taki veriyi de 90.textbox'a bıraktıktan sonra. 90.textbox'ta listview'deki 7.satırın bilgisi geliyor. aşağıda kodlar mevcut. başka siteden almıştım. çok işime yaramıştı, ama problem çıkınca işin içinden çıkamadım. değerli yardımlarınızı ve fikirlerinizi bekliyorum. şimdiden çok teşekkür ederim.


Private sec As String, secilen As Variant, secen As Name
Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If secilen <> Empty Then
gerial = Split(secilen, vbCrLf)
ListView1.ListItems.Add , , gerial(0)
For i = 0 To UBound(gerial) - 1
ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , gerial(i)
Next i
End If
End Sub


Private Sub ListView1_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
sec = True
secilen = ""

End Sub

Private Sub TextBox50_Change() '51,52,53.......149
k = 50
ara = Controls("TextBox" & k).Name
Controls("TextBox" & k).MultiLine = True
Sheets("info").Activate
Set t = Sheets("info").Range("P").Find(ara)
'veri yoksa
On Error Resume Next
Application.DisplayAlerts = False
If Len(Controls("textbox" & k)) = 0 Then Sheets("info").Range(Cells(t.Row, 21).Address, Cells(t.Row, 31).Address).Value = "": secilen = "": GoTo atla1

'Listviewden alırken

If Len(Controls("textbox" & k)) <> 0 And sec = True Then


Controls("textbox" & k).Text = ListView1.SelectedItem.Text & vbCrLf & ListView1.SelectedItem.SubItems(1) & vbCrLf & ListView1.SelectedItem.SubItems(2) & vbCrLf & ListView1.SelectedItem.SubItems(3) & vbCrLf & ListView1.SelectedItem.SubItems(4) & vbCrLf & ListView1.SelectedItem.SubItems(5) & vbCrLf & ListView1.SelectedItem.SubItems(6) & vbCrLf & ListView1.SelectedItem.SubItems(7) & vbCrLf & ListView1.SelectedItem.SubItems(8) & vbCrLf & ListView1.SelectedItem.SubItems(9) & vbCrLf & ListView1.SelectedItem.SubItems(10) & vbCrLf

Sheets("info").Cells(t.Row, 21).Value = ListView1.SelectedItem.Text
Sheets("info").Cells(t.Row, 22).Value = ListView1.SelectedItem.SubItems(1)
Sheets("info").Cells(t.Row, 23).Value = ListView1.SelectedItem.SubItems(2)
Sheets("info").Cells(t.Row, 24).Value = ListView1.SelectedItem.SubItems(3)
Sheets("info").Cells(t.Row, 25).Value = ListView1.SelectedItem.SubItems(4)
Sheets("info").Cells(t.Row, 26).Value = ListView1.SelectedItem.SubItems(5)
Sheets("info").Cells(t.Row, 27).Value = ListView1.SelectedItem.SubItems(6)
Sheets("info").Cells(t.Row, 28).Value = ListView1.SelectedItem.SubItems(7)
Sheets("info").Cells(t.Row, 29).Value = ListView1.SelectedItem.SubItems(8)
Sheets("info").Cells(t.Row, 30).Value = ListView1.SelectedItem.SubItems(9)
Sheets("info").Cells(t.Row, 31).Value = ListView1.SelectedItem.SubItems(10)
Application.SendKeys "{pgup}"
Application.SendKeys "{pgup}"
sec = False
End If
'tetxtbox'tan textbox'a ????????
If Len(Controls("textbox" & k)) <> 0 And secilen <> "" Then
Controls("textbox" & k).Text = secilen
s = 1
sütun = 21
For i = 1 To Len(Controls("textbox" & k))
sayi = sayi + 1
If Mid(Controls("textbox" & k), i, 2) = vbCrLf Then
Sheets("info").Cells(t.Row, sütun).Value = Mid(Controls("textbox" & k).Text, s, sayi - 1)
sayi = 0
sütun = sütun + 1
s = i + 2
i = i + 1
End If
Next i
Application.SendKeys "{pgup}"
Application.SendKeys "{pgup}"
sec = False

secilen = ""
End If
atla1:

sec = False

End Sub


Private Sub Textbox50_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
k = 50
Controls("textbox" & k).SelStart = 0
Controls("textbox" & k).SelLength = Len(Controls("textbox" & k).Text)
secilen = Controls("textbox" & k)
End Sub

 

[Costcost]

konu güncel. hatanın nerden kaynaklandığına dair fikir verebilirseniz çok memnun olurum. teşekkürler.

 

[Costcost]

Merhabalar,
yukarıda açıkladığım sorunu bulamadım maalesef.
Aşağıdaki kodun satırlarını açıklayabilir misiniz mümkünse? yardımlarınız için şimdiden teşekkür ederim.

'tetxtbox'tan textbox'a sürükle bırak ile veri aktarımı.

If Len(Controls("textbox" & k)) <> 0 And secilen <> "" Then
Controls("textbox" & k).Text = secilen
s = 1
sütun = 21
For i = 1 To Len(Controls("textbox" & k))
sayi = sayi + 1
If Mid(Controls("textbox" & k), i, 2) = vbCrLf Then
Sheets("info").Cells(t.Row, sütun).Value = Mid(Controls("textbox" & k).Text, s, sayi - 1)
sayi = 0
sütun = sütun + 1
s = i + 2
i = i + 1
End If
Next i