Toplu yazdır

[mcetinkaya65]

Dosyamın kişi özel sayfasına açılır pencereden (ComboBox1) ile seçtiğim köyün istediği kitapları Kitaplar sayfasından getiriyor.Yazdır butonuda F stunundaki dolu hücreleri filtreleyip yazdırıyor.
İstediğim tabiki mümkün ise;
Yazdır makrosunu öyle bir düzenleyelim ki Liste sayfasındaki F sutununda dolu olanları yani sıfırdan büyük olanları kişi özel sayfasında köye göre verileri kitaplar sayfasından getirip yine kşi özel sayfasının f stunundaki sıfırdan büyük olanlarını filtreleyip yazdırması mümkün mü?

 

[askm]

Aşağıdaki kodları kullanın.

Sub kod()
Dim s1, s2 As Worksheet
    Set s1 = Sheets("Kişi Özel")
    Set s2 = Sheets("Liste")

sonsat = s2.Cells(65536, "A").End(xlUp).Row

For i = 7 To sonsat
Sayfa1.ComboBox1.Value = s2.Cells(i, 2).Value
    With Sheets("Kişi Özel")
    If Range("f1").Value <> 0 Then
    
        On Error Resume Next
        If Not .AutoFilterMode Then
            .Range("A1").AutoFilter
        Else
            .ShowAllData
        End If
        On Error GoTo 0
        
        .Range("$A$2:$F$57").AutoFilter Field:=6, Criteria1:="<>0"
        .PrintOut
        
        On Error Resume Next
        If Not .AutoFilterMode Then
            .Range("A1").AutoFilter
        Else
            .ShowAllData
        End If
        On Error GoTo 0
     End If
    End With
   
Next i
End Sub

 

[mcetinkaya65]

Üstad ilginiz için teşekkür ederim.
Liste sayfasının f stunundaki dolu olan hücreleri yazdırması gerekiyor. bu makro hepsini yazdırıyor.

 

[askm]

.Range("$A$2:$F$57").AutoFilter Field:=6, Criteria1:="<>0"
.PrintOut
Bu kısımda zaten siz 0 dan farklı olanları filtreliyorsunuz.
If Range("f1").Value <> 0 Then
bu kısımda toplamı sıfırdan büyük ise o sayfayı yazdırıyor. Toplam sıfır ise o camii geçiyor.
Yalnız ben denemek için For i = 7 kısmını 7 yapmıştım onu For i = 2 olarak değiştirin.

 

[askm]

Sorunu yeni gördüm. Kodları aşağıdaki şekilde değiştirin.

Sub kod()
Dim s1, s2 As Worksheet
    Set s1 = Sheets("Kişi Özel")
    Set s2 = Sheets("Liste")

sonsat = s2.Cells(65536, "A").End(xlUp).Row

For i = 2 To sonsat
Sayfa1.ComboBox1.Value = s2.Cells(i, 2).Value
    With Sheets("Kişi Özel")
    If Range("e1").Value > 0 Then
    
        On Error Resume Next
        If Not .AutoFilterMode Then
            .Range("A1").AutoFilter
        Else
            .ShowAllData
        End If
        On Error GoTo 0
        
        .Range("$A$2:$F$57").AutoFilter Field:=6, Criteria1:="<>0"
        .PrintPreview ' PrintOut
        
        On Error Resume Next
        If Not .AutoFilterMode Then
            .Range("A1").AutoFilter
        Else
            .ShowAllData
        End If
        On Error GoTo 0
     End If
    End With
   
Next i
End Sub

 

[mcetinkaya65]

Yalnız ben denemek için For i = 7 kısmını 7 yapmıştım onu For i = 2 olarak değiştirin.[/QUOTE]


Değişikliği ile işlem tamam. 2. kod baskı ön izleme sayfadına geçiyor orda kalıyor.
Allah Razı olsun

 

[askm]

.PrintPreview ' bu kısmı silin. Boşuna 40-50 sayfa çıktı almamak için baskı önizlemeye almıştım. " .PrintOut " şeklinde kalırsa direkt çıktı alır." .PrintPreview " baskı önizleme işlemi için kullanılır.

 

[mcetinkaya65]

Teşekkürler