Makro ile print

[HBKN84]

Selamlar, kolay bir sorum olacak. Sayfada atıyorum A1:B100 hücresini sayfa1 olarak yatay olacak şekilde ve D5:F150 aralığını sayfa 2 olarak yatay olacak şekilde ve her iki hücrede sayfaya 1x1 oranında sığacak şekilde çıktı alabilmek için bir makro kodu ihtiyacım var.

Tşkler.

 

[HBKN84]

Eklemeyi unuttum sayfa 1'de 3 tane grafik var onlarda sayfada görünecek.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz. Grafikleriniz bu aralıktaysa yazıcıdan çıkacaktır. Aksi halde onlarıda kapsayacak alanı belirtmeniz gerekiyor.

Sub Yazdir()
    ActiveSheet.PageSetup.PrintArea = "$A$1:$B$100"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveSheet.PrintOut
 
    ActiveSheet.PageSetup.PrintArea = "$D$5:$F$150"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveSheet.PrintOut
 
    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub

 

[HBKN84]

yazmış olduğunuz kodu denedim 2 hata verdi bana. 1.si printquality hatası verdi diğeride ActiveWindow.SelectedSheets.Print kısmına gelince hata verdi.

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki kodu güncelledim. Tekrar denermisiniz.

 

[HBKN84]

tekrar denedim bu seferde ActiveSheets.PrintOut kısmında hata verdi.

 

[Korhan Ayhan]

Evet haklısınız... Acele ile kırmızı harfi fazla yazmışım. Tekrar düzelttim. Deneyiniz.

ActiveSheet[COLOR=red]s[/COLOR].PrintOut

 

[HBKN84]

Tam istediğim gibi olmuş korhan bey elinize sağlık, teşekkür ederim.