Kağıt boyutu seçme

[Mehmet Sait]

Merhaba,

Ekli kod ile seçili alanı pdf yapıyorum. Kağıt boyutunu her defasında " 9x12 cm (3,5 x 5 in) 8,9 cm x 12,7 cm " olarak ayarlamak zorunda kalıyorum, kağıt seçimini otomotik olarak nasıl yapabilirim.

Yardımlarınız için teşekkür ederim.

Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
'AyAdi = Format(Date, "mmmm")
'klasoradi = Format(Date, "dd.mm.yyyy") & " "

dosyaadi = [B5].Value & " Gündüz&Akşam ve " & [D5].Value & " Gece Vardiyaları " & [B2].Value & ".pdf"

'dosyaadi = [B2]
klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi

ActiveSheet.Range("$B$2:$D$33").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        masaustuyolu & "\" & dosyaadi & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
        
MsgBox "  PDF olarak kaydedildi..! "

 

[Korhan Ayhan]

Merhaba,

Ben bu tarz işlemler için makro kaydet yöntemini kullanıyorum. Kendi sistemimde bu yöntemle yazdırma işlemi sırasında 10. sıradaki sayfa boyutunu seçtim. Aşağıdaki kod oluştu. Sizde aynı yöntem ile ilgili kod satırını tespit edebilirsiniz.

Yazdırma alanı ayarları olduğu için birçok satır görünüyor. Aslında aşağıdaki tek satır işinizi görecektir. Kod içinden bold olan kısımları aldım.

ActiveSheet.PageSetup.PaperSize = xlPaper11x17

Sub Macro1()
'
' Macro1 Macro
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaper11x17
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .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
End Sub

 

[Mehmet Sait]

Merhaba,

Ben bu tarz işlemler için makro kaydet yöntemini kullanıyorum. Kendi sistemimde bu yöntemle yazdırma işlemi sırasında 10. sıradaki sayfa boyutunu seçtim. Aşağıdaki kod oluştu. Sizde aynı yöntem ile ilgili kod satırını tespit edebilirsiniz.

Yazdırma alanı ayarları olduğu için birçok satır görünüyor. Aslında aşağıdaki tek satır işinizi görecektir. Kod içinden bold olan kısımları aldım.

ActiveSheet.PageSetup.PaperSize = xlPaper11x17

Sub Macro1()
'
' Macro1 Macro
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaper11x17
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .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
End Sub

Merhaba, dediğiniz yöntemi denedim oldu. Teşekkür ederim.

With ActiveSheet.PageSetup
.PaperSize = 281
End With