Koşula bağlı belli aralığı yazdırmak.

[Hakan ERDOST]

Herkese kolay gelsin.Açıklama ekteki dosyda.Bir çeşitli yazdırma makrosu.Umarım üstadlar yardımcı olur.

 

[Muhammet Okumuş]

Merhaba,

Sub SatırGizle()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
son = Range("B10000").End(3).Row + 7
For i = 2 To son
If Cells(i, 51) = 0 Then Rows(i).EntireRow.Hidden = True
Next
Application.Calculation = xlCalculationAutomatic
End Sub

kodunu deneyiniz.

 

[Hakan ERDOST]

Merhaba,


kodunu deneyiniz.

Üstad teşekkürler.Kod yavaşta olsa çalışıyor ancak sorunum var.Şöyleki yazıcı çıktısında bir sayfayı filitrelese de ben başlık yazdırma kullanığım için sayfalar ön zilemeye geliyor.Başlık yazdırmayı kaldırdığımda hata veriyor.
Birde bunu direk önzileme ve yazdıra bağlayabilirmiyiz?

 

[Hakan ERDOST]

Bir diğer sorun da korumalı sayfada kod yine hata veriyor.


Veeee kod kesinlikle çok yavaş çalışıyor.

 

[Muhammet Okumuş]

Hocam yavaş çalışmasının nedeni birleştirilmiş hücrelerden kaynaklanıyor.

 

[Hakan ERDOST]

Sub SatırGizle()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
son = Range("B601").End(3).Row + 7
For i = 2 To son
If Cells(i, 51) = 0 Then Rows(i).EntireRow.Hidden = True
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Kod satırınızın altına küçük bir ilave de yaptım.Ancak belirttiğiniz gibi birleştirilmiş satırlar ve formüler var dosyada (örnek dosyada yok).Bu nedenle biraz sadeleştirrerek hız kazandırdım.
Sizden ricam bu kodun altına birde gizleme sonrası yazdırma fonksiyonu eklemek ve boş sayfaların önizlemeye gelmemesi.Yanlızca filitrelenen veriler gelsin.

 

[Muhammet Okumuş]

Sub SatırGizle()
Cells.EntireRow.Hidden = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
son = Range("B10000").End(3).Row + 7
For i = 2 To son
If Cells(i, 51) = 0 Then Rows(i).EntireRow.Hidden = True
Next
Application.Calculation = xlCalculationAutomatic
son1 = Range("AY1000").End(3).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$AZ$" & son1
ActiveSheet.PrintPreview
End Sub

bu şekil deneyiniz.

 

[Hakan ERDOST]

bu şekil deneyiniz.

Üstad teşekkürler.Makro bu şekliyle çalışıyor.Ancak filtreleme sırasında her sferinde sayfa sonu değiştiği için bir sayfaya 12 satır yazdırıken başke bir sayfaya 6 satır yazdırıyor.Bunu gidermek mümkünmü?

 

[Muhammet Okumuş]

Hocam orasını ben de anlamadım.

 

[Hakan ERDOST]

Umarım anlayan biri çıkar.

 

[Hakan ERDOST]

Konu güncel.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub GİZLE()
    Dim X As Long, Alan As Range, Satir As Long
    
    Application.ScreenUpdating = False
    
    Cells.EntireRow.Hidden = False
    
    For X = 2 To Cells(Rows.Count, "Q").End(3).Row
        If Cells(X, "AY") = 0 Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, "AY")
            Else
                Set Alan = Union(Alan, Cells(X, "AY"))
            End If
        End If
    Next
                
    Alan.EntireRow.Hidden = True
    
    Satir = Cells(Rows.Count, "Q").End(3).Row
    ActiveSheet.PageSetup.PrintArea = "A1:AZ" & Satir
    ActiveSheet.PrintPreview
    
    Application.ScreenUpdating = True
End Sub

 

[Hakan ERDOST]

Teşekkürler.