Yazdırma alanı belirleme. (Formül sonucu boş olmayanları)

[whirlybird]

Merhaba elimde bir sayım listesi mevcut, her ay sonunda almaktayım, yazım alanı olarak boş hücreler olmadan en alttaki yazı üste kayacak şekilde yazdırma alanı yapılıp çıktı alınabilir mi?

Not: Boş hücrelerde formül olup çıktıları " " dır.

 

[Ömer BARAN]

Merhaba.

Sorunuzu, resim yerine, örnek belge ile desteklerseniz, sonuca daha hızlı ulaşırsınız diye düşünüyorum.
(örnek belge özellikleri ve örnek belge yükleme konusundaki açıklamalar, cevabımın altındaki İMZA bölümünde var)
.

 

[Asri]

Aşağıdaki şekilde deneyiniz.

Kod, kullanılmayan satırları gizler, yazdırma alanı olarak belirleyip varsayılan yazıcıya yazdırır.
Daha sonra gizlenmiş satırları tekrar gösterir.

Sub yazdir()
    Application.ScreenUpdating = False
    gizlesonsatir = Cells(Rows.Count, "D").End(3).Row - 1
    For i = gizlesonsatir To 2 Step -1
      gec = Cells(i, "D").Value
      If gec = "" Then
        Rows(i).Hidden = True
      End If
    Next i
    
    sonsatir = Cells(Rows.Count, "D").End(3).Row
      
    secim1 = "D2:I" & sonsatir
    secim2 = "$D$2:$I$" & sonsatir
    Range(secim1).Select
    ActiveSheet.PageSetup.PrintArea = secim2
    Range("A1").Select
    ActiveSheet.PrintOut Copies:=1
    
    For i = gizlesonsatir To 2 Step -1
      gec = Cells(i, "D").Value
      If gec = "" Then
        Rows(i).Hidden = False
      End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[whirlybird]

Sayın Ömer Baran bey, öneriniz ve yol göstericiliğiniz için çok minnettarım ne kadar da haklısınız. Bir dahaki sefere öyle yapacağım.

Sayın Asri bey verdiğiniz kod harfiyen oluyor ve çok mutlu oldum tam da tarif ettiğim şekilde yapmışsınız elinize kolunuza yüreğinize sağlık. Sadece ufak bir sorunum var makro çok ağır çalışıyor onu hızlandırma yolu var mıdır? (D3:I194 tablo sınırımdır)

 

[Asri]

Sayın Ömer Baran bey, öneriniz ve yol göstericiliğiniz için çok minnettarım ne kadar da haklısınız. Bir dahaki sefere öyle yapacağım.

Sayın Asri bey verdiğiniz kod harfiyen oluyor ve çok mutlu oldum tam da tarif ettiğim şekilde yapmışsınız elinize kolunuza yüreğinize sağlık. Sadece ufak bir sorunum var makro çok ağır çalışıyor onu hızlandırma yolu var mıdır? (D3:I194 tablo sınırımdır)

Çok haklısınız diyorsunuz, ama hala dosya linki yok : )

 

[Asri]

Örnek dosya olmayınca tam istenen sonuç alınmaması normal : )

Aşağıdaki şekide deneyiniz.

Sub yazdir()
   Application.ScreenUpdating = False
   Dim rngBlnk As Range

   On Error Resume Next
   Set rngBlnk = Range("D4:D193").SpecialCells(xlCellTypeBlanks)
   On Error GoTo 0

   If Not rngBlnk Is Nothing Then
      rngBlnk.EntireRow.Hidden = True
   End If

   ActiveSheet.PrintOut Copies:=1
    
   rngBlnk.EntireRow.Hidden = False

   Application.ScreenUpdating = True
End Sub

 

[whirlybird]

Asri bey yeni ekledim çizelge temsilidir, makrolar o yüzden yoktur saygılar.

ÖRNEK.xlsx - 25 KB

 

[whirlybird]

Örnek dosya olmayınca tam istenen sonuç alınmaması normal : )

Aşağıdaki şekide deneyiniz.

Sub yazdir()
   Application.ScreenUpdating = False
   Dim rngBlnk As Range

   On Error Resume Next
   Set rngBlnk = Range("D4:D193").SpecialCells(xlCellTypeBlanks)
   On Error GoTo 0

   If Not rngBlnk Is Nothing Then
      rngBlnk.EntireRow.Hidden = True
   End If

   ActiveSheet.PrintOut Copies:=1
    
   rngBlnk.EntireRow.Hidden = False

   Application.ScreenUpdating = True
End Sub

Haklısınız istenen sonuç için ek gerekli, yukarıdaki kodu denedim boş hücreler beraberinde çıktı oluyor asri bey.

 

[Asri]

Haklısınız istenen sonuç için ek gerekli, yukarıdaki kodu denedim boş hücreler beraberinde çıktı oluyor asri bey.

Sayfanızda formüller var. Ancak herhangi bir yerden bilgi çekmiyorlar.
Bu yüzden makro çalışmıyor.
Bu formüller kullanılıyor mu? Silinsin mi?

E,F,G,H,I daki formüller silinerek ayarlandı.

Aslında başka bir sayfa daha var onu göndermedim formülleri orada kullanıyorum derseniz. Benden bu kadar : )

http://dosya.co/1zm1i6sy4vwe/SatirGizleYazdir.xlsm.html

Sub yazdir()
   Application.ScreenUpdating = False
   Dim rngBlnk As Range
   sonsatir = Cells(Rows.Count, "F").End(3).Row + 1
   
   On Error Resume Next
   Set rngBlnk = Range("F4:F172").SpecialCells(xlCellTypeBlanks)
   On Error GoTo 0

   If Not rngBlnk Is Nothing Then
      rngBlnk.EntireRow.Hidden = True
   End If
   
   secim1 = "D3:I" & sonsatir
   secim2 = "$D$2:$I$" & sonsatir
   Range(secim1).Select
   ActiveSheet.PageSetup.PrintArea = secim2
   Range("A1").Select
    
   ActiveSheet.PrintOut Copies:=1
   
   If Not rngBlnk Is Nothing Then
      rngBlnk.EntireRow.Hidden = False
   End If

   Application.ScreenUpdating = True
End Sub

 

[whirlybird]

Asri bey çok güzel olmuş elinize sağlık, oradaki formüller ana veri ağacından bilgileri çekiyor ve liste ona göre şekilleniyor. O şekilde de kullanılıyor çok sağ olsun teşekkür ederim.

 

[Korhan Ayhan]

Alternatif olarak deneyiniz.

Sub YAZDIR()
    Dim Son As Long, X As Long, Alan As Range
    
    Application.ScreenUpdating = False
    
    Cells.EntireRow.Hidden = False
    Son = Cells(Rows.Count, "E").End(3).Row
    
    For X = 5 To Son
        If Cells(X, "D") = "" Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, "D")
            Else
                Set Alan = Union(Alan, Cells(X, "D"))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then Alan.EntireRow.Hidden = True
    ActiveSheet.PrintOut
    Cells.EntireRow.Hidden = False

    Application.ScreenUpdating = True

    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub