Soru Userformda Çoklu Seçimli Listboxtaki Verileri Tek Bir Hücreye Alt Alta Yazdırma

[Korhan Ayhan]

Örnek dosya üzerinden tarif ediniz.

 

[MyMamoste]

Veri Girişi ve DB diye iki sayfam var.

Veri Girişi kısımdaki sütunlara DB sayfasından ADODB sorgu ile kategori ismine göre veri çekiyorum. Bunu Userform Listbox ile Veri Girişi kısımdaki hücrelere aktarıyorum.

Veri Girişi kısımdaki hücrelerde çift tıklayınca o hücrenin başlığı ile aynı olan DB sayfasında bulunan sütundan veriler Listboxta çıkıyor bu verilere tıklayıp Kaydet butonuna basınca aktif olan hücreye aktarılıyor.

Örnek veriyorum....

DB sayfasında Medeni diye bir sütun var ve sütunun altında Evli Bekar Dul Doşanmış şeklinde veriler alt alta sıralı.. Veri Girişi adındaki sayfada da Medeni adında bir sütun var onun altındaki hücreye tıklayınca Userform listbox açılıyor listeden istedğim medeni durumu seçiip kaydediyorum... Ben bu medeni listesine Diğer diye bir seçenek ekledim DB sayfasında ve haliyle listboxta da listeleniyor. Diğer adındaki seçeneğe tıklanınca kullanıcının karşısına bir kutucuk çıkmasını ve o kutucuğu doldurmasını ve doldurduğu bilginin de aktif olan hücreye gitmesini istiyorum. Örneğin Bekar yerine Evlenmemiş diye kullanıcı tarafından yazılan yazı yazılsın oraya...

Kodlar da bir önceki mesajımda yer alıyor. Bir yardım kuruluşuna hayrıma hazırlıyorum bu basit programı sadece bu kısım kaldı. Saygılarımla.

YARDIM KURULUŞUNUN VERİLERİ GİZLENEREK DOSYAYI AŞAĞIDA SUNDUM HOCAM, YARDIMIN ÇOK ÖNEMLİ.

 

[Korhan Ayhan]

Önerdiğim kod içindeki aşağıdaki bölüm sizin için yeterli olacaktır.

Sadece aktif hücre düzeltmesi yaptım.

Yalnız sizin form üzerinde ListBox nesnesinde çalışmadı. Bende nesneyi silip yeniden ekleyip sonuca gittim.

Private Sub ListBox1_Click()
    Dim Veri As Variant
    If ListBox1.Value = "Diğer" Then
10      Veri = InputBox("Lütfen diğer seçimi için açıklama giriniz...", "Açıklama")
        If Veri = "" Then GoTo 10
        ActiveCell = Veri
    End If
End Sub

 

[MyMamoste]

Önerdiğim kod içindeki aşağıdaki bölüm sizin için yeterli olacaktır.

Sadece aktif hücre düzeltmesi yaptım.

Yalnız sizin form üzerinde ListBox nesnesinde çalışmadı. Bende nesneyi silip yeniden ekleyip sonuca gittim.

Private Sub ListBox1_Click()
    Dim Veri As Variant
    If ListBox1.Value = "Diğer" Then
10      Veri = InputBox("Lütfen diğer seçimi için açıklama giriniz...", "Açıklama")
        If Veri = "" Then GoTo 10
        ActiveCell = Veri
    End If
End Sub

Hocam benim listboxta çalışmamasının sebebini buldum. Listbox Multiselect seçili olması, Single olunca çalışıyor ama çoklu olunca bu kod çalışmıyor, bunu çoklu kodda da nasıl çalıştırabilirim hocam. Yüzdük yüzdük kuyruğuna geldik.

Multiselect için kullandığım kod, çoklu seçimleri hücreye yazdırmak için. Bu kod ile sizin verdiğiniz diğer kodu karşılaştırıp multiselect seçili iken de çalışmasını sağladık mı bitecek sorun. Saygılar hocam

Private Sub CommandButton1_Click()
Cells(Me.TextBox1, Me.TextBox2) = Me.ListBox1
ActiveCell = ""
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
    If ActiveCell = "" Then
        ActiveCell = ListBox1.List(i)
    Else
        ActiveCell = ActiveCell & Chr(10) & ListBox1.List(i)
    End If
End If
Next
Unload Me

End Sub

 

[Korhan Ayhan]

O zaman Buton kullanmanız gerekir.

 

[MyMamoste]

O zaman Buton kullanmanız gerekir.

Hocam fikir verebilir misiniz? Kafa tamamen durdu

 

[Korhan Ayhan]

Böyle deneyiniz.

Private Sub CommandButton1_Click()
    Cells(Me.TextBox1, Me.TextBox2) = Me.ListBox1
    ActiveCell = ""
    For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        If ListBox1.List(i) = "Diğer" Then
10          Veri = InputBox("Lütfen diğer seçimi için açıklama giriniz...", "Açıklama")
            If Veri = "" Then GoTo 10
            If ActiveCell = "" Then
                ActiveCell = Veri
            Else
                ActiveCell = ActiveCell & Chr(10) & Veri
            End If
        Else
            If ActiveCell = "" Then
                ActiveCell = ListBox1.List(i)
            Else
                ActiveCell = ActiveCell & Chr(10) & ListBox1.List(i)
            End If
        End If
    End If
    Next
    Unload Me
End Sub

 

[MyMamoste]

Böyle deneyiniz.

Private Sub CommandButton1_Click()
    Cells(Me.TextBox1, Me.TextBox2) = Me.ListBox1
    ActiveCell = ""
    For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        If ListBox1.List(i) = "Diğer" Then
10          Veri = InputBox("Lütfen diğer seçimi için açıklama giriniz...", "Açıklama")
            If Veri = "" Then GoTo 10
            If ActiveCell = "" Then
                ActiveCell = Veri
            Else
                ActiveCell = ActiveCell & Chr(10) & Veri
            End If
        Else
            If ActiveCell = "" Then
                ActiveCell = ListBox1.List(i)
            Else
                ActiveCell = ActiveCell & Chr(10) & ListBox1.List(i)
            End If
        End If
    End If
    Next
    Unload Me
End Sub

Hocam Çok Teşekkür Ederim. Sorunsuz hem çoklu hem de diğer seçeneği çalıştı. Saygılar

 

[emre67z]

Hocam Çok Teşekkür Ederim. Sorunsuz hem çoklu hem de diğer seçeneği çalıştı. Saygılar

hocam çalışmaya kendinizde birşeyler kattınızı anladım mesajlardan. Çalışmanın son halini bizlere de paylaşabilir misiniz. Teşekkürler, Saygılarımla