Listbox içinde çoklu seçim

[Hakan ERDOST]

Dosya ve açıklamalar ekte...

 

[Ömer BARAN]

Merhaba.

İlgili kod kısımlarını aşağıdakiyle değiştirerek istediğiniz olabilir.
VERİ sayfasında veli isimleri örnek belgenizde boş, oraya rastgele veriler yazın ki işlemin gerçekleştiği anlaşılsın.
Aktarılan ListBox1 satırının;
-- işaretinin kaldırılması için mavi olan satırı,
-- listeden kaldırılması için kırmızı olan satırları,
kullanın.
kaldırılır.
.

[B]Private Sub CommandButton3_Click()[/B]
[B][COLOR="Red"]son = ListBox1.ListCount - 1[/COLOR][/B]
With Sheets("VTT")
[COLOR="red"][B].[D6][/B] = CDate(TextBox3.Value):[B] .[D7][/B] = Format(TextBox6.Value, "hh:mm")
[B].[A13][/B] = TextBox1.Text:[B] .[A22] [/B]= TextBox4.Text:[B] .[A50][/B] = TextBox5.Text
[B].[B11][/B] = "Veli Toplantısı " & .[D6] & " " & Format(.[D6], "dddd") & " günü saat " & _
        Format(TextBox6.Value, "hh:mm") & " 'da aşağıdaki gündem maddelerini"
[B].[A12][/B] = "görüşmek üzere gerçekleştirilmiş ve aşağıdaki kararlar alınmıştır."[/COLOR]
    For a = 0 To ListBox1.ListCount - 1
[COLOR="Red"][B]        If a > son Then Exit For[/B][/COLOR]
        If ListBox1.Selected(a) = True Then
            vttsat = .Cells(Rows.Count, 2).End(3).Row + 1
            .Cells(vttsat, 2) = ListBox1.List(a)
                satır = WorksheetFunction.Match(ListBox1.List(a), Sheets("VERİ").Range("C:C"), 0)
            .Cells(vttsat, "A") = vttsat - 61
[B][COLOR="Blue"]            ListBox1.Selected(a) = False[/COLOR][/B]
[B][COLOR="Red"]            ListBox1.RemoveItem a[/COLOR][/B]
[COLOR="red"][B]            son = son - 1: a = a - 1[/B][/COLOR]
        End If
    Next
[COLOR="Red"]    TextBox1 = "": TextBox2 = "": TextBox3 = "": TextBox4 = "": TextBox5 = "": TextBox6 = ""[/COLOR]
End With
[B]End Sub

Private Sub UserForm_Initialize()[/B]
ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectMulti
With Sheets("VERİ")
    For sat = 2 To .Cells(Rows.Count, 1).End(3).Row
        If .Cells(sat, 1) > 0 Then ListBox1.AddItem .Cells(sat, 3)
    Next
End With
[B]End Sub[/B]

 

[Orion1]

Kırmızı olacaksa.

For a = ListBox1.ListCount - 1 to 0 step -1

 

[Ömer BARAN]

Evet Sayın GİZLEN haklısınız.
Sıralama da değişmesin diye, o soruna yönelik düzeltmeyi ekliyordum.

Önceki cevabımdaki kod'a ilave yaptım.
.

 

[Hakan ERDOST]

Sayın Ömer BARAN öncelikle emekleriniz için teşekkürler,yazdığınız kodu tutanak yaz butonuna atadım ancak,
1-Kod listboxdaki seçimleri tek tek aktarıyor, toplu aktarmıyor,
2-Userform üzerindeki nesnelerde de doğal olarak veri olacak ve bunlar ve başlıkları hem VTT hem de VTV sayfalarında mevcut,
3-Veli bilgisini aktarmasına gerek yok, çünkü toplantıya veli adına başkası (dede,anneane vb) gelebiliyor.Öğrebci listesi yeterli.

Dosyayı kodlu haliyle ekliyorum. Tekrar teşekkürler.

 

[Ömer BARAN]

Koddaki döngü hatasını fark etmemişim, şimdi düzelttim.
Kırmızı satırları kullanarak istediğiniz sonuca ulaşılabiliyor.

Belgenizdeki
-- B11:K11 hücre aralığındaki metinleri silin ve bu hücreleri birleştirip,
-- Belgenizdeki A12:K12 hücre içeriklerini silin ve bu hücreleri birleştirip,
hizalamalarını SOL yapın.
-- VTV sayfasında yapılacak işlemi anlamadım.

Sayfayı yenileyerek tekrar kontrol edin isterseniz.
.

 

[Hakan ERDOST]

Teşekkürler.

 

[Hakan ERDOST]

Sayın Ömer BARAN ilgili verilerimi VTT sayfasına Tutanak Yaz düğmesi ile aktarıyorum. Ancak tutanaklar ve gündem maddeleri değişken olduğundan hücreye sığmayabiliyor, açıklamam dosya ekinde var.

 

[Hakan ERDOST]

Bir noktaya geldim. Ancak kod aşağıdaki satırda hata veriyor;

 Target.RowHeight = YÜKSEKLİK

Dosyanın son hali ekte

 

[Ömer BARAN]

Bence birleştirilmiş çoklu satır/çoklu sütun için satır yüksekliği ayarlama işlemi yerine;
formdaki TextBox'a yazılan metni,
-- satır başı kriterine göre ayrı satırlara alt alta yazdırmak,
-- ardından bu satırlarda METNİ KAYDIR özelliği üzerinden satır yüksekliğini ayarlamak
daha doğru olur diye düşünüyorum.
.

 

[Hakan ERDOST]

Ömer bey aslında istediğim bir yerde oldu tek bir sorun var. Belirttiğim hata acaba excelin sınırından mı kaynaklanıyor onu bilmiyorum. Araştırdım hücre-satır yükseklik sınırı 409 punto deniyor karakter sınırı 30000 küsur.Anlayamadığım nokta burada dosyanın son hali ekte.

 

[Hakan ERDOST]

Bence birleştirilmiş çoklu satır/çoklu sütun için satır yüksekliği ayarlama işlemi yerine;
formdaki TextBox'a yazılan metni,
-- satır başı kriterine göre ayrı satırlara alt alta yazdırmak,
-- ardından bu satırlarda METNİ KAYDIR özelliği üzerinden satır yüksekliğini ayarlamak
daha doğru olur diye düşünüyorum.
.

Sanırım başka çare kalmadı (Çünkü satır yüksekliğinin sınırı varmış :=)) Ömer bey. Belirttiğiniz şekilde son eklediğim dosya üzerinde yol gösterirseniz sevinirim.

 

[Ömer BARAN]

Merhaba.

Biraz etrafından dolaşarak oldu ama ekteki belgeyi bir deneyin isterseniz.

Sayfadaki hücrelerde bir değişiklik yapmadan USERFORMu açın.
-- Metin kutularına yazılan metinler, SATIRBAŞI karakteri kriterine göre satırlara dağıtılır.
-- Başlıklar da buna göre konumlandırılır.

EK belgeyi yeniledim ( 25.03.2017 01:01 )
.

 

[Hakan ERDOST]

Ömer Bey teşekkürler.
yalnız kod ,

  *** BURDAN AŞAĞISI İSİM LİSTELEME / LİSTBOX'TAN SİLME
son = ListBox1.ListCount
baş = karsat + ak + 3
    For a = 0 To ListBox1.ListCount
        If a > son Then Exit For
        If ListBox1.Selected(a) = True Then
            vttsat = .Cells(Rows.Count, 2).End(3).Row + 1
            .Cells(vttsat, 2) = ListBox1.List(a)
        Satır = WorksheetFunction.Match(ListBox1.List(a), Sheets("VERİ").Range("C:C"), 0)
            .Cells(vttsat, "A") = vttsat - baş
            ListBox1.RemoveItem a
            son = son - 1: a = a - 1
        End If
    Next
    TextBox1 = "": TextBox2 = "": TextBox3 = "": TextBox4 = "": TextBox5 = "": TextBox6 = "": TextBox7 = ""
End With

aşağıdaki satırda veri aktarıyor ancak hata vererek vba penceresine dönüyor

 If ListBox1.Selected(a) = True Then

 

[Ömer BARAN]

Tekrar merhaba.

Kod'un ilgili bölümüne aşağıdaki kırmızı satırları ekleyerek dener misiniz.
.

'*** BURDAN AŞAĞISI İSİM LİSTELEME / LİSTBOX'TAN SİLME
[B][COLOR="Red"]Application.CutCopyMode = False[/COLOR][/B]
son = ListBox1.ListCount
baş = karsat + ak + 3
    For a = 0 To ListBox1.ListCount
[COLOR="red"][B]        If ListBox1.Selected(a) = False Then seç = seç + 1
        If seç = ListBox1.ListCount Then GoTo 100[/B][/COLOR]
        If a > son Then Exit For
        If ListBox1.Selected(a) = True Then
            vttsat = .Cells(Rows.Count, 2).End(3).Row + 1
            .Cells(vttsat, 2) = ListBox1.List(a)
        satır = WorksheetFunction.Match(ListBox1.List(a), Sheets("VERİ").Range("C:C"), 0)
            .Cells(vttsat, "A") = vttsat - baş
            ListBox1.RemoveItem a
            son = son - 1: a = a - 1
        End If
    Next
[B][COLOR="Red"]100:[/COLOR][/B]
    TextBox1 = "": TextBox2 = "": TextBox3 = "": TextBox4 = "": TextBox5 = "": TextBox6 = "": TextBox7 = ""
End With

 

[Hakan ERDOST]

Teşekkürler Ömer Bey.

 

[Ömer BARAN]

Gördüğüm birkaç eksikliği gidererek önceki cevabımın ekindeki belgeyi yeniledim.
Sayfayı yenileyerek eklediğim belgeyi yeniden indirip dener misiniz?

 

[Orion1]

Bu satırı aşağıdaki satırla değiştiriniz.

For a = 0 To ListBox1.ListCount

bununla değiştiriniz.

For a = 0 To ListBox1.ListCount [B][COLOR="Red"]-1[/COLOR][/B]

 

[Hakan ERDOST]

Bu satırı aşağıdaki satırla değiştiriniz.

For a = 0 To ListBox1.ListCount

bununla değiştiriniz.

For a = 0 To ListBox1.ListCount [B][COLOR="Red"]-1[/COLOR][/B]

Çalışma sayfası açıkken sorun yok. Ömer Bey'in son eklediği kodlar çalışıyor hatasız. Ancak form üzerinde işlem yaparken (çalışma sayfası arka planda yok) kod hata veriyor.

 

[Orion1]

Çalışma sayfası açıkken sorun yok. Ömer Bey'in son eklediği kodlar çalışıyor hatasız. Ancak form üzerinde işlem yaparken (çalışma sayfası arka planda yok) kod hata veriyor.

Şunu deneyin.

For a = ListBox1.ListCount -1 to 0 step -1