Makro İle Kağıt Ebatı Seç ve Yazdır

[ormann]

İyi günler;
Ekli dosyada Userform2 de ComboBox3 ile kağıt sayfasında B ve C sütunlarında kağıt ebatlarını seçip bu seçilen ebata göre makro ile yazdırma yapabilir miyiz ?.Yardımlarınızı bekliyorum.Saygılar
https://www.dosyaupload.com/aqhE

 

[ormann]

Arkadaşlar konu ile ilgili yardımcı olabilir misiniz?

 

[askm]

Kağıt ebatlarını öncelikle yazıcınıza yazıcı özelliklerinden ilgili yazı tiplerini eklemeniz gerekli sanırım. Sonrasında örneğin aşağıdaki kod ile Sayfa4 ün kağıt boyutunu değiştiriebiliyoruz.
Worksheets("Sayfa4").PageSetup.PaperSize = xlPaperA4 'A4 Formatı için
Worksheets("Sayfa4").PageSetup.PaperSize = xlPaperLetter 'Letter formatı için

 

[askm]

Combobox3 kodlarını aşağıdaki şekilde değiştirirseniz olur.

Private Sub ComboBox3_Change()
On Error Resume Next
Application.DisplayAlerts = False
Set S1 = Sayfa1
Set Alan = S1.Range("d16:L36")
Yol = ThisWorkbook.Path & "\"
Dosya_Adı = Yol & "ws" & ".jpg"
Application.ScreenUpdating = False
    Set S2 = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=S2.Name

    S2.PageSetup.PaperSize = "xlPaper" & ComboBox3.Text 'Bu satır eklendi.

    Set XL_Chart = ActiveChart
    Alan.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    XL_Chart.Paste
    Set XL_Picture = Selection
    With XL_Chart.Parent
        .Border.LineStyle = 0
        .Width = Image1.Width
        .Height = Image1.Height
    End With
    XL_Chart.Export Filename:=Dosya_Adı, FilterName:="jpg"
    S2.Delete
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\ws.jpg")
Kill ThisWorkbook.Path & "\ws.jpg"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub