Soru Son Satıra Kadar Yazdır ve Ön İzle

[Hsn55]

İyi akşamlar ekli dosyada Listbox1 den seçmiş olduğum sayfaları buton ile yazdır ve ön izle yapıyorum. Benim burada yapmak istediğim seçmiş olduğum sayfaların son satıra kadar olan kısımlarını ön izleme ve yazdırma işlemi yaptırmak istiyorum. Destek olursanız sevinirim

Private Sub CommandButton1_Click()
Set S1 = Sheets("ANA SAYFA")
If S1.ListBox1.ListIndex < 0 Then MsgBox "Listeden Ön İzleme Yapılacak Sayfayı Seçiniz?", vbInformation, "DİKKAT": Exit Sub
If Me.ListBox1 <> "" Then Sheets(ListBox1.Text).PrintPreview
End Sub


Private Sub CommandButton2_Click()
Beep
Set S1 = Sheets("ANA SAYFA")
If S1.ListBox1.ListIndex < 0 Then MsgBox "Listeden Yazdırılacak Sayfayı Seçiniz?", vbInformation, "DİKKAT": Exit Sub
Dim SayfaAdedi As Integer
    
    SayfaAdedi = Application.InputBox("LÜTFEN KOPYA SAYISINI GİRİNİZ ?", "KOPYA SAYISI GİRİŞİ !!!!", 1, Type:=2)
If Not SayfaAdedi = 0 Then Sheets(ListBox1.Text).PrintOut From:=1, To:=1, Copies:=SayfaAdedi
End Sub

EK_ODEME_BORDROSU.xlsm dosyasını indir - download

EK_ODEME_BORDROSU.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[mesuttasar]

Yazdırmak veya ön izleme yaptırmak istediğiniz sayfaların formatları birbirinden farklı, o yüzden ya bunları aynı formata getirmeye çalışın ya da her sayfa için ayrı kod yazın. Ayrıca makro koduna öncelikle sayfa yazdırma alanlarını sıfırlayacak kodu ActiveSheet.PageSetup.PrintArea = "" yazdıktan sonra son dolu hücreyi buldurarak yeni bir yazdırma alanını belirleyerek istediğiniz sonuca ulaşabilirsiniz.

Örnek olarak B sütunundaki son dolu hücrenin satır bilgisi için kod: son=[B10000].end(3).row
Yeni yazdırma alanı seçimi için aşağıdaki kodları mevcut kodlarınıza ekleyip devam edebilirsiniz.

ActiveSheet.PageSetup.PrintArea = ""
' ilave kodlarınız
son=[B10000].end(3).row

Rng = Range("B1:Q" & son)

ActiveSheet.PageSetup.PrintArea = Rng

'ilave kodlarınız