Soru dolu alanı yazdırma

[NADİR YILDIZ]

[TR][TD]
arkadaşlar sarı alanı yazdırmak istiyorum.ancak bazen bu tablo A10 satırına kadar dolu oluyor bazen A500 satırını kadar dolu oluyor.formüllü alan sayısı çok liste uzayıp gidiyor.bazen 40-50 sayfa oluyor. yani kısacası hücreleri dolu olan alanları sayfaya yada sayfalara sığdırmak istiyorum.formüllü alanı yazdırmak istemiyorum.sayfa düzeninden yazdırma alanı belirleyerek yapmak istesem olmuyor çünkü tablo ne kadar dolu olacağı belli olmuyor veri girişi değişken olduğu için alan sabit değil.her seferinde seçimi yazdır şeklinde seçim yaparak dökmekte zaman alıyor.makrolu bir çözümü var mıdır ?
[/TD][/TR]

 

[kulomer46]

Değerli Arkadaşım Merhaba

Aşağıdaki makro kodu işini görür.

Selamlar...

Sub Özel_Alan_Yazdir()

    i = 1
    Do While Trim(Cells(i, 2)) = ""
        i = i + 1
    Loop
    
    ilkb = i
    If ilkb > 1 Then ilkb = ilkb - 1
    sonb = Cells(Rows.Count, 2).End(3).Row
    
    Range("B" & ilkb & ":J" & sonb).Select
    ActiveSheet.PageSetup.PrintArea = "$B$" & ilkb & ":$J$" & sonb
    
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$" & ilkb & ":$J$" & sonb
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
    C = MsgBox("B-J sütunlarında Dolu Alanlar seçilmiştir." & Chr(10) & Chr(10) _
    & "B-J sütunlarında sadece seçili olan Dolu Alanların yazdırılması yapılacak." _
    & Chr(10) & Chr(10) & "Onaylıyor musunuz?", vbOKCancel, "Seçili Alanlar Yazdırılacak")
    
    If C = vbCancel Then Exit Sub
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

 

[NADİR YILDIZ]

sayın kulomer46 merhaba

ilginize teşekkürler.ancak aşağıdaki hatayı veriyor nerden kaynaklı acaba

Application.PrintCommunication = True

iyi çalışmalar

 

[Korhan Ayhan]

Alternatif;

İlk olarak elle SARI alandan birkaç hücre seçip yazdırma alanını oluşturunuz.
Sonrasında FORMÜLLER-AD YÖNETİCİSİ menüsünü açın.

Karşınıza aşağıdaki gibi bir ekran gelecektir.

Kırmızı kutucuk içindeki bölüme aşağıdaki formülü uygulayıp hemen solundaki onay (tik) butonuna tıklayıp işlemi tamamlayın.

Bu formül "B" sütununa gör son dolu satırı tespit eder. Siz kendi tablonuza göre revize edersiniz.

=DOLAYLI("B2:J"&ARA(2;1/($B:$B<>"");SATIR($B:$B)))

 

[kulomer46]

sayın kulomer46 merhaba

ilginize teşekkürler.ancak aşağıdaki hatayı veriyor nerden kaynaklı acaba

Application.PrintCommunication = True

iyi çalışmalar

Merhaba

Application.PrintCommunication = True satırını devre dışı bırakınız.
Büyük ihtimalle sorunsuz çalışacaktır.

Selamlar...

 

[NADİR YILDIZ]

sayın kulomer46 teşekkürler

 

[NADİR YILDIZ]

sayın korhan ayhan teşekkürler