Boş sayfaları yazdırmama

[whirlybird]

Merhaba, 1-17 sayfa arasında değişken olarak yazdırma listem mevcuttur yani bazen 3 sayfa bazen 17 sayfa dolmaktadır. Ben "Yazdır" düğmesi ekledim ve buna öğle bir makro kodu eklemeliyim ki sadece dolu olan sayfaları yazdırabileyim yardımcı olabilecek bir arkadaşım var mıdır?
Yardımlarınız için şimdiden teşekkür ederim.

 

[alicimri]

Sayın whirlybird

sadece dolu olan sayfaları yazdırabileyim .

den kastınız tamamen boş sayfa ise aşağıdaki kodu kullanabilirsiniz.

Sub a()
For i = 1 To Sheets.Count
If Application.CountBlank(Sheets(i).Cells) <> 17179869184 Then
'yazdırma kodu
End If
Next
End Sub

 

[whirlybird]

Sayın alicimri, ilginize çok teşekkür ederim dediğiniz kodu girdim ancak olmadı farklı bir kod yazılma ihtimali var mıdır?

 

[alicimri]

Boş dediğiniz sayfalar tamamen boş mu? hiç bir metin yok mu? Bu 17 sayfanın hepsi aynı formatta mı?

 

[alicimri]

kodlardaki
'yazdırma kodu
yerine

Sheets(i).PrintOut

yazın

 

[whirlybird]

alicimri, o kodu yapmıştım sonuç söyle oluyor;
1- Exceldeki tüm sayfaları yazdırıyor (sayfa1, sayfa2, sayfa3...)
2- Bana lazım olan sayfa1 olsun bunun içerisindeki 17 sayfayı da yazdırmaktadır.

Not: sayfa1 deki 300 satırına kadar her hücrede formül mevcut olup veri girişi yapılırsa dolu yapılmazsa boş olmaktadır ama boş olsa bile formül çıktısıdır umarım açıklayabildim.

 

[YUSUF44]

Aşağıdaki satırla A1 hücresinin boş olup olmadığını kontrol edebilirsiniz:

If [a1] <> "" Then

Dosyanızda boş olmaması gereken bir hücreye göre bu kodu düzenleyerek işinizi görebilirsiniz. Yani "şu hücre doluysa yazdır" gibi.

 

[alicimri]

Sayın whirlybird
İstediğinizi şimdi anladım (bir sonuç üretmese de) formül, kenarlık, hücre rengi olunca tüm sayfaları yazdırır. Bunu önlemek için her sayfanın metin olup olmadığı test edilmesi ve "yazdırma alanı belirle" ile belirleyip yazdırmak lazım. Bunun içinde sayfa şablonu nasıl olduğu bilinmesi lazım. (Birinci sayfa A1:I55, 2. sayfa A56: I112 gibi)

 

[whirlybird]

Sayın Yusuf44,
Dediğinizi çok iyi anladım ilginize teşekkür ederim ancak sorun şu ben normal olarak sayfa1'i yazdırıyorum toplamda 17 sayfa ama formüllere bağlı olduğu için bazen 13 bazen 3 bazen ise 17 sayfa tutmaktadır, şimdi benim istediğim sayfa1de sadece dolu olan sayfalar yazdırılsın boş sayfa çıktısı yazıcıya gitmesin istiyorum buna yardım ederseniz çok sevinirim.

 

[YUSUF44]

Yukarda verilen tüm kodları birleştirerek elde ettiğim aşağıdaki kod, her sayfayı ayrı ayrı kontrol eder ve A1 hücresi doluysa o sayfayı yazdırır:

Sub a()
For i = 1 To Sheets.Count
If Sheets(i).[a1] <> "" Then
Sheets(i).PrintOut
End If
Next
End Sub

 

[whirlybird]

Sayın whirlybird
İstediğinizi şimdi anladım (bir sonuç üretmese de) formül, kenarlık, hücre rengi olunca tüm sayfaları yazdırır. Bunu önlemek için her sayfanın metin olup olmadığı test edilmesi ve "yazdırma alanı belirle" ile belirleyip yazdırmak lazım. Bunun içinde sayfa şablonu nasıl olduğu bilinmesi lazım. (Birinci sayfa A1:I55,
2. sayfa A56: I112 gibi)

Sayın alicimri,
Yazdırma alanlarından aşağıdaki şekilde bahsettim toplam 23 satır sığmaktadır umarım yardımcı olur;

SAYFA1 = D6:L29
SAYFA2 = D30:L53
SAYFA3 = D54:L77
SAYFA4 = D78:L111

 

[whirlybird]

Yukarda verilen tüm kodları birleştirerek elde ettiğim aşağıdaki kod, her sayfayı ayrı ayrı kontrol eder ve A1 hücresi doluysa o sayfayı yazdırır:

Sub a()
For i = 1 To Sheets.Count
If Sheets(i).[a1] <> "" Then
Sheets(i).PrintOut
End If
Next
End Sub

Yusuf bey sorun hangi sayfayı yazdırmaktan ziyade yazdırılan sayfada 17 adet yaprak olması ve boş olanların yazdırılmaması.

 

[YUSUF44]

Sorunuzu şimdi anladım. Biz sayfayı hep excel sheet/sayfa/tablo olarak düşündük. Halbuki siz bir sheet içindeki boş satırların yazdırılmamasını istiyormuşsunuz. Bu da yapılabilir elbette. Ancak daha hızlı çözebilmemiz için bir örnek dosya hazırlayıp dosya yükleme sitelerinden birinde paylaşırsanız iyi olur. Düşüncem, eğer sayfa yapınız üstte dolu altta boş satırlar şeklindeyse son dolu satıra göre yazdırma alanı belirlemek şeklinde.

 

[whirlybird]

Sorunuzu şimdi anladım. Biz sayfayı hep excel sheet/sayfa/tablo olarak düşündük. Halbuki siz bir sheet içindeki boş satırların yazdırılmamasını istiyormuşsunuz. Bu da yapılabilir elbette. Ancak daha hızlı çözebilmemiz için bir örnek dosya hazırlayıp dosya yükleme sitelerinden birinde paylaşırsanız iyi olur. Düşüncem, eğer sayfa yapınız üstte dolu altta boş satırlar şeklindeyse son dolu satıra göre yazdırma alanı belirlemek şeklinde.

Yusuf bey zannedersem sorun da tam orada başlıyor 400'üncü satıra kadar formüllerim mevcut ama çıktılarının çoğu boş, son satıra kadar yazdırma alanı kodunu denedim ama yazdırmak istediğim 30. satıra kadar olsa da formül olduğu için 400. satırı son satır görmekte bu yüzden 17 sayfayı da yazdırmaktadır.

 

[alicimri]

Sayın whirlybird aşağıdaki kodları kendinize uyarlayın. ben ilk sütun A, son sütunu I ve sayfaların alt alta olduğunu varsaydım.

Function varmi(alan As Range)
For i = 1 To alan.Count
If Len(alan(i)) > 0 Then
varmi = "var"
Exit For
Else
varmi = "yok"
End If
Next
End Function
Sub Makro3()
son = Range("A65535").End(xlUp).Row
ActiveWindow.View = xlPageBreakPreview
ilk = 1
For Each pb In ActiveSheet.HPageBreaks
ilk = ilk & " " & pb.Location.Row 
Next
ilk = Split(ilk, " ")
On Error Resume Next
If varmi(Range("A" & ilk(0) & ":" & "I" & ilk(1) - 1)) = "var" Then
   ActiveSheet.PageSetup.PrintArea = "A" & ilk(0) & ":" & "I" & ilk(1) - 1
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
  ActiveSheet.PageSetup.PrintArea = ""
   End If
For i = 1 To UBound(ilk)
If i = UBound(ilk) Then
If varmi(Range("A" & ilk(i) & ":" & "I" & son)) = "var" Then
ActiveSheet.PageSetup.PrintArea = "A" & ilk(i) & ":" & "I" & ilk(i) + 40
 ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveSheet.PageSetup.PrintArea = ""
End If
Else
If varmi(Range("A" & ilk(i) & ":" & "I" & ilk(i + 1) - 1)) = "var" Then
ActiveSheet.PageSetup.PrintArea = "A" & ilk(i) & ":" & "I" & ilk(i + 1) - 1
 ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveSheet.PageSetup.PrintArea = ""
End If
End If
Next
ActiveWindow.View = xlNormalView
End Sub

 

[alicimri]

Sayın whirlybird dün gece sizin 11 nolu mesajınızı görmemiştim. Yukardaki kodlar satır sayısı ve satır yükseklikleri değişken sayfaları yazdırıyor. Mesajınızdaki açıklama işi daha kolaylaştırdı. Yeni kodlar aşağıda

Sub Makro2()
On Error Resume Next
ilk = 6
son = 29
For i = 1 To 17
Set rRange = ActiveSheet.Range("D" & ilk & ":" & "L" & son).SpecialCells(xlCellTypeConstants)
If Not rRange Is Nothing Then
ActiveSheet.PageSetup.PrintArea = "D" & ilk & ":" & "L" & son
ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = ""
Set rRange = Nothing
End If
ilk = ilk + 24
son = son + 24
Next
End Sub

 

[whirlybird]

Sayın alicimri ve YUSUF44,

Çok teşekkür ederim ikinizin yazmış olduğu kodları tek tek denedim ve ikisi de mükemmel çalıştı, bu da Excel'in ne kadar çok fonksiyonlu olduğunu gösteriyor, ellerinize sağlık çok sağ olun.

Not: Her iki kodu da kaydettim ikisini de sıra ile kullanacağım.