Kağıt boyutu seçme

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
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.


Kod: 
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,159
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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

Rich (BB code): 
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
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Korhan Ayhan' Alıntı:
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

Rich (BB code): 
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
Genişletmek için tıkla ...
Merhaba, dediğiniz yöntemi denedim oldu. Teşekkür ederim.

Kod: 
With ActiveSheet.PageSetup
.PaperSize = 281
End With
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst