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

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Örnek dosya üzerinden tarif ediniz.
 

MyMamoste

Altın Üye
Katılım
31 Mart 2013
Mesajlar
28
Excel Vers. ve Dili
Excel 2019 Türkçe
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İ.
 

Ekli dosyalar

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Ö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.

C++:
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

Altın Üye
Katılım
31 Mart 2013
Mesajlar
28
Excel Vers. ve Dili
Excel 2019 Türkçe
Ö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.

C++:
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

Kod:
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
O zaman Buton kullanmanız gerekir.
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Böyle deneyiniz.

C++:
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

Altın Üye
Katılım
31 Mart 2013
Mesajlar
28
Excel Vers. ve Dili
Excel 2019 Türkçe
Böyle deneyiniz.

C++:
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

Altın Üye
Katılım
19 Haziran 2017
Mesajlar
209
Excel Vers. ve Dili
365
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
 
Üst