Listview ve Textbox

[Costcost]

Merhabalar,

Userform üzerinde 12 textbox ve 1 listview yer almaktadır. Listview'de yer alan kaydı, mouse ile textbox'a drag-drop ile bırakabiliyorum.
Sorunum ise, bıraktığım değeri textbox'ta mouse ile seçip, textbox'tan textbox'a drag-drop ile bırakırken seçilen değeri excel sayfasında kayıt yaparken, listview'deki farklı satırdaki değeri alıyor. Demek istediğim, seçtiğim textbox'taki değeri değil, listview'de kayıtlı değeri excel sayfasına kayıt yapıyor.
Problem aşağıdaki kod satırında sanırım; deneme yanılmayla çözmeye çalıştım ancak her seferinde hata ile karşılaştım. Program debug hatası vermedi.
Değerli yardımlarıınıza ihtiyacım var. Şimdiden ilginiz ve yardımınız için teşekkür ederim.

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

 

[Costcost]

Güncel,
Altın üye olmayanlar için dosya adresi.
yardımlarınız için teşekkürler şimdiden.

link: dosya

https://www.dosyaupload.com/affE

 

[FERAZ]

Merhaba.
ilk olarak ListView1.SelectedItem.SubItems(2) burası yanlış.
Çünkü Listview sütunluk.

 

[FERAZ]

ikinci olarak Controls("textbox" yerine Controls("TextBox" olacak.

 

[FERAZ]

Kodu alttaki gibi denermisiniz?
Kırmızı yerlere dikkat edin.Sadece Textbox2 için yaptım örnek olarak.

Private Sub TextBox2_Change()
k = 2
ara = Controls("TextBox" & k).Name
Controls("TextBox" & k).MultiLine = True
Sheets("ALFA").Activate
Set t = Sheets("ALFA").Range("B:B").Find(ara)

    
'XXXXXXX
'On Error Resume Next
Application.DisplayAlerts = False
If Len(Controls("TextBox" & k)) = 0 Then Sheets("ALFA").Range(Cells(t.Row, 4).Address, Cells(t.Row, 5).Address).Value = "": secilen = "": GoTo atla1

'XXXXX

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

    Controls("TextBox" & k) = ListView1.SelectedItem.Text & vbCrLf & ListView1.SelectedItem.SubItems(1)
    
    Sheets("ALFA").Cells(t.Row, 4).Value = ListView1.SelectedItem.Text
    Sheets("ALFA").Cells(t.Row, 5).Value = ListView1.SelectedItem.SubItems(1)
  
    
    'Sheets("ALFA").Cells(t.Row, 5).Value = ListView1.SelectedItem.SubItems(2)
    
Application.SendKeys "{pgup}"
Application.SendKeys "{pgup}"
sec = False
End If
'XXXXXXXXX
If Len(Controls("textBox" & k)) <> 0 And secilen <> "" Then
Controls("textbox" & k).Text = secilen
s = 1
sütun = 4
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 + 1
i = i + 1

End If
Next i
Application.SendKeys "{pgup}"
Application.SendKeys "{pgup}"
sec = False


secilen = ""
End If
atla1:
sec = False
Dim kes
For i = 1 To 12
    If Controls("TextBox" & i) <> "" Then
        Set t = Sheets("ALFA").Range("B:B").Find(Controls("TextBox" & i).Name)
        kes = Split(Controls("TextBox" & i), vbCrLf)
        Sheets("ALFA").Cells(t.Row, 4).Value = kes(0)
        Sheets("ALFA").Cells(t.Row, 5).Value = kes(1)
    End If

Next

   Set t = Nothing
    
'    Sheets("ALFA").Cells(t.Row, 5).Value = ListView1.SelectedItem.SubItems(1)

End Sub

 

[Costcost]

Feraz Hocam, ilginiz ve yardımınız için çok teşekkür ederim.
verdiğiniz kodu 12 textbox için denedim. yine aynı şekilde, textbox'tan textbox'a drag-drop yaparken değerler değişiyor maalesef.
sorunun ekran görüntüsü : https://www.dosyaupload.com/afi0 dosya
verdiğiniz kodun eklenmiş hali olan dosya, deneme1
Üyelerde veya Üstadlarda textbox'tan Textbox'a sürükle bırak koduyla ilgili makro örneği varsa bu konu başlığına gönderebilirlerse çok memnun olurum. tekrar teşekkür ederim ilginiz için. iyi akşamlar,

 

[FERAZ]

Rica ederim.
Dün denememde sadece Textbox2 için hata giderilmişti bende.
Hatanın sebebi şöyleydi;
Textboxtan textboxa sürüklerken listview üzerinden sürükleyince hata oluyordu garip şekilde.
Şöyle deneyin textboxtan sürüklerken listviewin üzerinden geçmeyin bu sefer sayfaya veri gelmez
Zaman bulunca diğer textboxlar içinde uyarlayabilirim.

 

[Costcost]

dediğinizi yaptım, geçekten çok enteresan durum. lisview'in üzerinden geçersem de veri değişiyor. garip.
yardımınız için çok teşekkürler Feraz Hocam, iyi akşamlar dilerim.

 

[FERAZ]

Sizede iyi akşamlar.
Sorun çözülür bence.

Zaman bulunca bitirince dosyayı yollarım.

 

[FERAZ]

Sabaha kadar sürdü sonunda başardım galiba

İki dosya ekliyorum biri kısa döngüyle diğeri uzun.Bir deneyiniz iyice benim beyin yandı

http://dosya.co/tqa9k7q8cni3/DENEME68.xlsm.html

http://dosya.co/gom1yzjl3g1j/DENEME68_-_KsaDongu.xlsm.html


Private Sub ListView1_OLEDragOver yerine Private Sub ListView1_OLESetData kullandım.

ilgili kodu aşağıdaki gibi değiştirdim sebebi textboxtan listviewe veri atarken sizinkinde olmuyordu galiba.

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)
        Dim Lste As ListItem
        Set Lste = ListView1.ListItems.Add(, , gerial(0))
        Lste.SubItems(1) = gerial(1)
        
    Set Lste = Nothing
End If
End Sub

Alttaki gibi döngü yapıp textboxlaran Call xyz olarak çağırttım kısa olarak.

Sub xyz()

ara = Controls("TextBox" & k).Name
Set t = Sheets("ALFA").Range("B:B").Find(ara)

    For i = 1 To 12
        If Controls("TextBox" & i) <> "" Then
            Set t = Sheets("ALFA").Range("B:B").Find(Controls("TextBox" & i).Name)
            kes = Split(Controls("TextBox" & i), vbCrLf)
            Sheets("ALFA").Cells(t.Row, 4).Value = kes(0)
            Sheets("ALFA").Cells(t.Row, 5).Value = kes(1)
        End If
    
    Next

   Set t = Nothing

End Sub

 

[Costcost]

Feraz Hocam, Allah sizden razı olsun, sizin yönteminizle gayet güzel çalışıyor. garip durum da ortadan kalkmış, Aklınıza sağlık. Keşke o kadar kendinizi çözmeye zorlamasaydınız. geçte olsa bir şekilde yapılırdı. Sıhhatinize dikkat edin, çözmeye odaklı olunca insan kaptırıyor kendini gerçekten, saatten bihaber olup sabahlayabiliyor. tekrar çok teşekkür ediyorum sizin değerli yardımlarınıza, ilginize.

 

[FERAZ]

Rica ederim üstadım.
Zamanın nasıl geçtiğini anlayamamıştım ve zamanımda boldu
Zaten olmasaydı çözüm textboxtan textboxa sürüklerken listviewi teyet geçmek gerekiyordu
Sizdende Allah razı olsun.