İstenilen Aralığı Yazdırma

[betoncu]

Yazdırma alanı T2:AK56 arası olacak ve A4 kağıdına 1x1 oranında sığdırılacak şekilde koda ihtiyacım vardır. Yardımcı olabilirmisiniz?

Kodu sayfanın neresine yazacağız bunu da belirtebilirmisiniz...

 

[Korhan Ayhan]

Merhaba,

Makro kaydet yöntemi ile aşağıdaki kodu elde ettim. Ben sadece hızlı çalışması için kırmızı satırları ekledim.

Sub Makro1()
Application.ScreenUpdating = False

ActiveSheet.PageSetup.PrintArea = "$T$2:$AK$56"
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)
.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 = 1
.PrintErrors = xlPrintErrorsDisplayed
End With

Application.ScreenUpdating = True

ActiveWindow.SelectedSheets.PrintPreview
End Sub

 

[betoncu]

Korhan bey kırmızı satırları ekledim derken neyi kast ettiniz anlayamadım. Bu yazılan tüm kodları girmelimiyim?

 

[betoncu]

Birde ayrı bir sorum olacak. Bu sorum için olan kodu ayrı kullanacağım.

P3 HÜCRESİNDE AYIN SON GÜNÜ YAZMAKTADIR. MESELA 30.09.2012 (Hücre biçimi tarih olacak şekilde.)

A4 KÂĞIDINA 1X1 ORANINDA SIĞDIRILACAK ŞEKİLDE;

P3 HÜCRESİNDEKİ TARİH AYIN 31 İSE,
YAZDIRMA ALANI AL2:BD56

P3 HÜCRESİNDEKİ TARİH AYIN 30 İSE,
YAZDIRMA ALANI AL2:BC56

P3 HÜCRESİNDEKİ TARİH AYIN 29 İSE,
YAZDIRMA ALANI AL2:BB56

P3 HÜCRESİNDEKİ TARİH AYIN 28 İSE,
YAZDIRMA ALANI AL2:BA56

OLAN KODA İHTİYACIM VARDIR.

 

[betoncu]

Korhan bey birde tüm sayfalarım yatay olarak bastırılacak. Sizin kodda düşey olarak ayarlanmış. Yatay için neresi düzelicek acaba?

 

[Korhan Ayhan]

Merhaba,

Önerdiğim kodları boş bir modüle ekleyin. Excel sayfanıza buton ekleyip kodu butona tanımlayın.

Ben bu işlemleri nasıl yapacağımı bilmiyorum diyorsanız aşağıdaki linki inceleyin.

Sayfada Buton-Düğme Oluşturmak ve Makro Atamak (Resimli Anlatım)

Sub KOŞULLU_YAZDIRMA_ALANI()
    Application.ScreenUpdating = False
    
    Select Case Day(Range("P3"))
        Case 31: ActiveSheet.PageSetup.PrintArea = "AL2:BD56"
        Case 30: ActiveSheet.PageSetup.PrintArea = "AL2:BC56"
        Case 29: ActiveSheet.PageSetup.PrintArea = "AL2:BB56"
        Case 28: ActiveSheet.PageSetup.PrintArea = "AL2:BA56"
        Case Else: ActiveSheet.PageSetup.PrintArea = ""
    End Select
    
    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)
        .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 = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    
    ActiveWindow.SelectedSheets.PrintPreview

    Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Merhaba,

Yatay ifadesini mesajlarınızda göremedim. Soru sorarken tüm detayları belirtmeniz gerekiyor.

Kod içindeki ".Orientation = xlPortrait" ifadesini aşağıadaki gibi değiştirin.

.Orientation = xlLandscape

 

[betoncu]

Dalgınlığıma gelmiş.Teşekkür ederim..

 

[betoncu]

Korhan bey son bir sorum olacak. Verdiğiniz kodları uygulayınca ekrana baskı önizleme seçeneği geliyor. Gelen menüde yazdır dedikten sonra yazdırma işlemi gerçekleşiyor.

Baskı önizleme menüsü gelmeden. Makroyu çalıştırdığımızda direk yazdırabilmesi için yukarıda yazılan kodda hangi bölümlerin silinmesi gerek acaba?

 

[betoncu]

Yardım

Merhaba,

Makro kaydet yöntemi ile aşağıdaki kodu elde ettim. Ben sadece hızlı çalışması için kırmızı satırları ekledim.

Arkadaşlar bu kodu uyguladığımızda çalışıyor fakat ekrana yazdırma penceresinin gelmesini istemiyorum..

Makroyu çalıştırdığımızda pencere açılmadan yazdırma işlemi için bu koda ne ekler veya çıkarırız?
Yardımlarınızı bekliyorum...

 

[parametre]

ActiveWindow.SelectedSheets.PrintPreview
Bu kodu kaldırınız kolay gelsin

yada direk bu kod işinizi gorur
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True,

birinci sayfayı yazdırır

 

[Korhan Ayhan]

Merhaba,

Bu tarz kodları makro kaydet yöntemi ile elde edebilirsiniz. Biraz araştırmacı olmanız gerekiyor. Bu şekilde kendinizi geliştirebilirsiniz.

Kod içindeki "ActiveWindow.SelectedSheets.PrintPreview" ifadesini aşağıdaki gibi değiştirip deneyin.

ActiveWindow.SelectedSheets.PrintOut

 

[betoncu]

Teşekkür ederim.. Çok sağolun..