ctrl/shift ile Listboxta birden fazla değer seçme ve seçilenleri yazdırma

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Private Sub UserForm_Initialize()
For a = 1 To Sheets.Count
    ListBox1.AddItem Sheets(a).Name
Next
End Sub
Listboxa getirdiğim sayfaların aynı anda birden fazla seçip,
seçilenleri CmdTmm butonu ile yazdır demem için ne yapmalıyım.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
çoklu seçim için listbox1 in özelliklerinden multiselect'i 1-frmmultiselectmulti yapmam gerekiyortmuş.
seçilenleri yazdırmak için ne yapmalı sorusu kaldı geriye (Textbox1 de yazan rakam kadar olursa makbule geçer)
Yardımlarınınz için teşekkür ederim
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Private Sub CommandButton1_Click()
Dim col As New Collection
With ListBox1
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                Say = Say + 1
                col.Add i
            End If
        Next i
    If Say = 0 Then
        MsgBox "Seçili veri bulunamadı"
        Else
        If MsgBox(Say & " adet Sayfayı Yazdırmak İstiyor musunuz?", vbYesNo) = vbYes Then
            For i = 1 To col.Count
                Sheets(col.Item(i) + 1).Name
'                Rows(col.Item(i) + 1).Delete
            Next i
'            .RowSource = ("a1:a" & [a65536].End(3).Row)
        End If
    End If
End With
Set col = Nothing
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
For a = 1 To ActiveWorkbook.Sheets.Count
    ListBox1.AddItem Sheets(a).Name
Next
End Sub
Seçili olan sayfa/sayfaların adını nasıl döndürebilirim?
Seçili olan sayfa/sayfaları nasıl yazdırabilirim?
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Private Sub CommandButton1_Click()
Dim col As New Collection
With ListBox1
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                Say = Say + 1
                col.Add i
            End If
        Next i
    If Say = 0 Then
        MsgBox "Seçili veri bulunamadı"
        Else
        If MsgBox(Say & " adet Sayfayı Yazdırmak İstiyor musunuz?", vbYesNo) = vbYes Then
            For i = 1 To col.Count
            Sheets(ListBox1.List(col.Item(i))).PrintOut Copies:=TextBox1.Value
                                             '.PrintPreview

            Next i
        End If
    End If
End With
Set col = Nothing
Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub SpinButton1_SpinDown()
If TextBox1 = 1 Then
    TextBox1 = 1
Else
    TextBox1 = TextBox1 - 1
End If
End Sub
 
Private Sub SpinButton1_SpinUp()
    TextBox1 = TextBox1 + 1
End Sub
Private Sub UserForm_Initialize()
TextBox1 = 1
For a = 1 To ActiveWorkbook.Sheets.Count
    ListBox1.AddItem Sheets(a).Name
Next
End Sub

Hallettim kodlar çalışıyor.
 
Üst