Toplu yazdırmak

[yanginci34]

Merhaba arkadaşlar, ekteki dosyada yardımcı olursanız sevinirim istediğim ORJ ve ÇALIŞMA sayfaları hariç 50 satıra kadar ve A sütunu ile H sütunu arası h sütunu son dolu satıra kadar A4 kağıdına sığacak şekilde toplu yazdırmak. Şimdiden teşekkürler.
Ekli dosyayı görüntüle SAYFA AL VE ALT TOPLAM ALözet.xlsm

 

[yanginci34]

Arkadaşlar konu gunceldir.

 

[yanginci34]

Yok mu yardımcı olacak ya da çok mu zor

 

[askm]

Sitede üye olanlar fırsat buldukça ilgileniyor. Bu yüzden sabredersenız cevap alacağınız kanaatindeyim.

 

[yanginci34]

Özür dilerim

 

[askm]

Yapmak istediğiniz işlem butona tıkladıktan sonra oluşan sayfaları yazdırmak mı amacınız, yoksa ORJ sayfasını yazdırmak mı?

 

[yanginci34]

Evet butona basılınca çıkan sayfalar

 

[askm]

Aşağıdaki kodları kullanabilirsiniz.

Sub ASKM_Yazdır()
Dim i As Integer
For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "ÇALIŞMA" And Sheets(i).Name <> "ORJ" Then
        With Sheets(i).PageSetup
            .PrintTitleRows = "$1:$1"
            .PrintArea = "$A$1:$H$" & Sheets(i).Range("B65536").End(3).Row
            .Zoom = 85
            .CenterHorizontally = True
        End With
        Sheets(i).PrintPreview 'Baskı Önizleme için (Direkt çıktı için bu satırın başına tek tırnak ekleyin. Alttaki satırdaki tek tırnağı kaldırın.
'        Sheets(i).PrintOut     'Çıktı almak için baştaki tek tırnağı kaldırın.
        
    End If
Next
MsgBox "Yazdırma işlemi tamamlandır...", vbInformation, "ASKM"
End Sub

 

[yanginci34]

Öncelikle yardımcı olduğunuz için teşekkür ederim fakat bazı sayfalarda h sütunu 2. Sayfaya yazdirilamiyor yani tablo 1 sayfaya sığmıyor.

 

[yanginci34]

Tamamdır yazmış olduğunuz koda ufak eklemelerle kenar boşluklarını sıfır yapınca tam istediğim gibi oldu çok teşekkür ederim.

 

[askm]

Rica ederim.