[ÇÖZÜLDÜ] Listwievde seçili satır ve alt öğelerini kolleksiyona alma

[hsayar]

Private Sub Lvw_AdSoyad_guncelle()
    Dim wsPers As Worksheet
    Dim i%
    Dim x
    Set wsPers = ThisWorkbook.Sheets("PRS")
        With Lvw_AdSoyad
            .ListItems.Clear
            For i = 2 To wsPers.Cells(65536, 1).End(xlUp).Row - 1
                If wsPers.Cells(2, 1) <> "" Then
                    .ListItems.Add , , wsPers.Cells(i, 1)
                    With .ListItems(.ListItems.Count)
                        .SubItems(1) = wsPers.Cells(i, 2)
                        .SubItems(2) = wsPers.Cells(i, 3)
                        .SubItems(3) = wsPers.Cells(i, 4)
                    End With
                End If
            Next i
        End With
    Set wsPers = Nothing
End Sub

Yukarıdaki kodlar ile doldurmuş olduğumuz listwiev nesnemizin, seçili satır ve alt öğlerini koleksiyona nasıl alabilirim. aşağıdaki kodlar sadece kendisini alıyor.

Private Sub CommandButton1_Click()                                                                      '##'
1    Dim col As New Collection                                                                               '##'
'*\ Lvw_AdSoyadde Seçili olanları koleksiyona al ve sayısını tesbit et...                                 '##'
2 With Lvw_AdSoyad                                                                                          '##'
3    For i = 1 To .ListItems.Count                                                                       '##'
4        If .ListItems(i).Checked Then
[B][COLOR=green]           col.Add .ListItems(i).Text[/COLOR][/B]                                         '##'
[COLOR=red][B]           'col.Add??? = .SubItems(i, 1).Text      'çek işaretli satırın 1.alt öğesi                                    '##'[/B][/COLOR]
[B][COLOR=red]           'col.Add??? = .SubItems(i, 2).Text       'çek işaretli satırın 2.alt öğesi                                                                    '##'[/COLOR][/B]
[COLOR=red][B]           'col.Add??? = .SubItems(i, 2).Text       'çek işaretli satırın 3.alt öğesi[/B][/COLOR]                                                                     
        End If
5    Next i                                                                                              '##'
''*\ ... Eğer işaretli olan satır yoksa prosodürden çık, ...                                               '##'
6        If col.Count = 0 Then                                                                           '##'
7            MsgBox "Seçili veri bulunamadı"                                                             '##'
8        Else                                                                                            '##'
9            Soru = CmbYazici.Value & " Yazıcısından " & col.Count & " adet çalışma sayfasından " & _
                   TextBox1.Value & " -er/-ar adet  Yazdırmak İstiyor musunuz?"                         '##'
10            If MsgBox(Soru, vbYesNo) = vbYes Then                                                       '##'
''*\ ... Listbox1 de seçili sayfaları CmbYazici deki yazıcıdan textbox1 deki kadar yazdır.               '##'
11                For i = 1 To col.Count                                                                  '##'
                    MsgBox col.Item(i) 'koleksiyona alınan ilk veri (seçili asıl öğe)
[COLOR=red][B]'                    MsgBox col.Item???1 'koleksiyona alınan i. veri (seçili 1.alt öğe)[/B][/COLOR]
[COLOR=red][B]'                    MsgBox col.Item???2 'koleksiyona alınan i. veri (seçili 2.alt öğe)[/B][/COLOR]
[COLOR=red][B]'                    MsgBox col.Item???3 'koleksiyona alınan i. veri (seçili 3.alt öğe)[/B][/COLOR]
'12                     Sheets(col.Item(i)).PrintOut _
'                    Copies:=TextBox1.Value, ActivePrinter:=CmbYazici.Value                              '##'
13                Next i                                                                                  '##'
14            End If                                                                                      '##'
15        End If                                                                                          '##'
16    End With    'Lvw_AdSoyad                                                                              '##'
17 Set col = Nothing                                                                                      '##'
'18 Unload Me                                                                                              '##'
End Sub

 

[hsayar]

ben bir şekilde halletim sn. hocalarım (daha kolayıona hayır demem)

'#########################################################################################################'
'#########################################################################################################'
'#########         Raporla_ADOBB modülü ile oluşan Personel isimli çalışma sayfasından           #########'
'#########         [Personelin Adı Soyadı,   Mali Yıl,    Gider Türü,  Masraf Mrkz]              #########'
'#########         başlıklarını Lvw_AdSoyad nesnesine alarak seçilen personeli, cmbYazici        #########'
'#########         nesnesindeki combodan textbox1 adet kadar yazdırır...                         #########'
'#########         [URL="http://www.excel.web.tr/hsayar"]www.excel.web.tr/hsayar[/URL] 29/08/2008-12:30.                                     #########'
'#########         açılışta seçiliyor.                                                           #########'
'#########################################################################################################'
'#########################################################################################################'
Private i As Single
Private Sub UserForm_Activate()                                                                        '##'
'UserformlardaEkOzellik prosodürü hsr.xla dan çalışmaktadır.
1 Call KlsrDgr                                                                                         '##'
2 Dim dsyIco$:  dsyIco = klsrAddIns & AppPthSept & "Hsr_ico" & AppPthSept & "Print8.ico"   'icon yolu  '##'
3 Call UserformlardaEkOzellik(Me, False, True, True, True, False, True, False, False, True, True _
                              , dsyIco)                                                                '##'
End Sub                                                                                                '##'
'######################################################################################################////

Private Sub UserForm_Initialize()                                                                      '##'
'*\ Form denetimlerininin özelliklerini belirle                                                        '##'
    CommandButton2.Cancel = True                 'Userform üzerinde "ESC" ye basınca çıkışa izin ver.  '##'
    TextBox1 = 1:                       Cbx_AdSoyad.Caption = "Tüm  Sayfaları  Seç"                      '##'
    With Lvw_AdSoyad                                                                                     '##'
        .View = lvwReport:              .LabelEdit = lvwManual                                         '##'
        .CheckBoxes = True                                          'Her elemana CheckBox oluşturur.   '##'
        .ColumnHeaders.Clear:           .ListItems.Clear              'başlıkları ve öğeleri temizle   '##'
        .ColumnHeaders.Add , , "Adı Soyadı", 142                    'başlık ve genişliklerini ayarla     '##'
        .ColumnHeaders.Add , , "Malyt Yılı", 50, lvwColumnRight
        .ColumnHeaders.Add , , "Gider Türü", 100
        .ColumnHeaders.Add , , "Masraf Merkezi", 100
    End With   'Lvw_AdSoyad                                                                              '##'
'*\ Değişken tanımlama ve set etme                                                                     '##'
    Dim Wsh As WshNetwork:          Set Wsh = New WshNetwork                                           '##'
'**\ Aktif Bilgisayardaki Yazıcı Listesini CmbYazici e alır                                            '##'
    With CmbYazici                                                                                     '##'
        For i = 1 To Wsh.EnumPrinterConnections.Count - 1 Step 2                                       '##'
            .AddItem Wsh.EnumPrinterConnections(i)                                                     '##'
        Next                                                                                           '##'
'**\ Varsayılan yazıcıyı Combo1e atar                                                                  '##'
        .Value = FncHsr_VarsayilanYazici()                                                             '##'
    End With 'CmbYazici                                                                                '##'
'**\ Data sayfasının f5:f65536 aralığındaki benzersiz kayıtları cmb_bYIL sayfasıan getir.
Call Lvw_AdSoyad_guncelle                                                                                            '##'
'*\ Değişkenleri ve değerlerini hafızadan silme                                                        '##'
Set Wsh = Nothing:                  i = 0                                                              '##'
End Sub                                                                                                '##'

Private Sub Lvw_AdSoyad_guncelle()
    Dim wsPers As Worksheet
    Dim i%
    Dim x
    Set wsPers = ThisWorkbook.Sheets("PRS")
        With Lvw_AdSoyad
            .ListItems.Clear
            For i = 2 To wsPers.Cells(65536, 1).End(xlUp).Row - 1
                If wsPers.Cells(2, 1) <> "" Then
[COLOR=green][B]                    .ListItems.Add , , wsPers.Cells(i, 1)[/B][/COLOR]
[COLOR=green][B]                    With .ListItems(.ListItems.Count)[/B][/COLOR]
[COLOR=green][B]                        .SubItems(1) = wsPers.Cells(i, 2)[/B][/COLOR]
[COLOR=green][B]                        .SubItems(2) = wsPers.Cells(i, 3)[/B][/COLOR]
[COLOR=green][B]                        .SubItems(3) = wsPers.Cells(i, 4)[/B][/COLOR]
[COLOR=green][B]                    End With[/B][/COLOR]
                End If
            Next i
        End With
    Set wsPers = Nothing
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)                               '##'
    'Call UserForm_EnterKapa2                                                                           '##'
End Sub                                                                                                '##'
'######################################################################################################////

Private Sub CommandButton1_Click()                                                                     '##'
1    Dim col As New Collection                                                                         '##'
2    Dim wsData As Worksheet:              Set wsData = ThisWorkbook.Sheets("DATA")                    '##'
3    Dim RngVeriSuz As Range                                                                           '##'
4    With wsData                                                                                       '##'
5       SonSat = .Cells(65536, 2).End(3).Row                                                           '##'
6        Set RngVeriSuz = .Range("B4:P" & SonSat)                                                      '##'
7    End With                                                                                          '##'
'*\ Lvw_AdSoyadde Seçili olanları koleksiyona al ve sayısını tesbit et...                              '##'
8       With Lvw_AdSoyad                                                                               '##'
9           For i = 1 To .ListItems.Count                                                              '##'
10               With .ListItems(i)                                                                    '##'
11                    If .Checked Then                                                                 '##'
12                       col.Add .Text                                                                 '##'
[COLOR=darkgreen][B]13                        col.Add .SubItems(1)                                                         '##'[/B][/COLOR]
[COLOR=darkgreen][B]14                        col.Add .SubItems(2)                                                         '##'[/B][/COLOR]
[COLOR=darkgreen][B]15                        col.Add .SubItems(3)[/B][/COLOR]                                                         '##'
16                    End If                                                                           '##'
17                End With                                                                             '##'
18           Next i                                                                                    '##'
''*\ ... Eğer seçili olan sayfa yoksa prosodürden çık, ...                                             '##'
19        If col.Count = 0 Then                                                                        '##'
20            MsgBox "Seçili veri bulunamadı"                                                          '##'
21       Else                                                                                          '##'
22           Soru = CmbYazici.Value & " Yazıcısından " & col.Count / 4 & " adet personel analiz sayfasını " & _
                  TextBox1.Value & " -er/-ar adet  Yazdırmak İstiyor musunuz?"                         '##'
23            If MsgBox(Soru, vbYesNo) = vbYes Then                                                    '##'
''*\ ... Listbox1 de seçili sayfaları CmbYazici deki yazıcıdan textbox1 deki kadar yazdır.             '##'
24              For i = 1 To col.Count [COLOR=darkgreen][B]Step 4[/B][/COLOR]                                                          '##'
[COLOR=darkgreen][B]25                    RngVeriSuz.AutoFilter Field:=2, Criteria1:=col.Item(i + 0)                       '##'[/B][/COLOR]
[COLOR=darkgreen][B]26                    RngVeriSuz.AutoFilter Field:=6, Criteria1:=col.Item(i + 1)                       '##'[/B][/COLOR]
[COLOR=darkgreen][B]27                    RngVeriSuz.AutoFilter Field:=7, Criteria1:=col.Item(i + 2)                       '##'[/B][/COLOR]
[COLOR=darkgreen][B]28                    RngVeriSuz.AutoFilter Field:=8, Criteria1:=col.Item(i + 3)                       '##'[/B][/COLOR]
29                    wsData.PrintOut Copies:=TextBox1.Value, ActivePrinter:=CmbYazici.Value           '##'
30               Next i                                                                                '##'
31            End If                                                                                   '##'
32        End If                                                                                       '##'
33    End With    'Lvw_AdSoyad                                                                         '##'
34 Set col = Nothing: Set RngVeriSuz = Nothing                                                         '##'
35 Unload Me                                                                                           '##'
End Sub