yazdırılacak sayfaları 1 sayfaya sığdıracak makro nasıl yazılır?

[Selçuk1]

selamlar;

forumdan yararlanarak yazdığım bir dizi kod ile bana lazım olan verileri bir sekmede topluyorum ve tablodaki boş satırların gizlenmesini sağlayarak yazdırma işlemine kolaylık olsun diye baskı önizleme yaptırıyorum. buraya kadar her şey normal. ancak tabloya yazılacak verilerin sayıca fazla olması durumunda tablom bir sayfaya sığmıyor. ancak ben her durumda tablomun bir sayfa olmasını istiyorum. yani tablom bir sayfadan fazla ise sayfayı bir sayfaya sığdırsın. bu işlemi manuel olarak yapmak yerine kodlarla yapabilir miyiz?

 

[Recep İpek]

Aşağıdaki kodları kullanabilirsiniz.

Sub Macro1()
    Range("A1:E250").Select
    With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview
    Range("A1").Select
End Sub

 

[Selçuk1]

sn. ripek;

ilginiz ve paylaşımınız için teşekkürler. ancak kodlar tam olarak işimi görmedi sanırım. :roll:

yani oluşturulan tablo 1 sayfadan fazla olduğu takdirde önizlemede de 2 sayfa olarak gösteriyor ve 2 sayfa olarak kalıyor, yani 1 sayfaya sığdırmıyor. benim istediğim sayfayı % olarak küçültmesi (dosya/sayfa yapısı menüsünden yapılan işlem gibi) yada direkt olarak sığdırması. bunu nasıl yapabiliriz?

 

[Recep İpek]

Sub Macro1()
    Range("A1:E250").Select
 End Sub

Bu satırı kendi tablonuzdaki alanlara göre uyarlamanız gerekmektedir.

Olmazsa örnek küçük bir dosya eklerseniz onun üzerinden gidebiliriz.

 

[Korhan Ayhan]

Selamlar,

Makro kaydet yöntemi ile aşağıdaki kodu elde ettim. Sayfanız üzerinde alan seçip makroyu çalıştırın. Seçtiğiniz alanı otomatik olarak tek sayfaya sığdırır ve kenar boşluklarına 1 değerini atar. Umarım işinize yarar.

Sub BİR_SAYFAYA_SIĞDIR()
    SEÇİM = Selection.Address
    ActiveSheet.PageSetup.PrintArea = SEÇİM
    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 = 300
        .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
    Range("A1").Select
    ActiveWindow.SelectedSheets.PrintPreview
End Sub

 

[Selçuk1]

sn. cost_control;

cevabınız için çok teşekkür ederim. evet tam olarak istediğim buydu.

iki sorum daha olacak, manuel işlemi ortadan kaldırmak için kodlarınızın ilk satırını aşağıdaki gibi değiştirdim;

SEÇİM = Sheets("PSR").Range("A1:F54").Select

ancak hata verdi. bunu nasıl yapabiliriz? bir diğer sorum bu şekilde önizlemeyi yaptıktan sonra tablonun çıktısını alıyorum, anasayfaya dönerken tablonun bulunduğu sayfanın eski ayarlarına dönmesini istiyorum. çünkü bir sonraki tablo bu kadar uzun olmayabilir ve 1 sayfaya sığabilir. bu ikisini nasıl yapabiliriz?

 

[Korhan Ayhan]

Selamlar,

Örnek bir dosya eklerseniz yardımcı olmaya çalışırız.

 

[Selçuk1]

sn. cost_control;

ikinci sorduğum soruyu unutun.. zaten sayfanın uzunluğuna göre kendisini ayarlıyormuş, bunu şimdi farkettim.. :mrgreen::mrgreen: peki seçimi otomatik yapmak için kodu nasıl değiştirmeliyim?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki satırları silip;

    SEÇİM = Selection.Address
    ActiveSheet.PageSetup.PrintArea = SEÇİM

Yerine aşağıdaki kodu kullanın.

    ActiveSheet.PageSetup.PrintArea = "$A$1:$F$54"

 

[Selçuk1]

çok teşekkürler sn. cost_control üstadım. aynen dediğiniz gibi. :mrgreen: :mrgreen: :mrgreen:

elleriniz dert görmesin, istediğim tam olarak buydu. iyi geceler diliyorum.

 

[Selçuk1]

sn. cost_control ve diğer üstadlarım;
yukarıdaki kod tam olarak istediğim işlemi yapmakta ve işimi ziyadesiyle görmekteydi. aşağıdaki satır hata verene kadar. farklı bilgisayarlarda kullandığımda programı yazıcı özelliğine göre aşağıdaki kod satırı hata veriyor. yani bazılarında 600 yaptığımda kabul ediyor, bazılarında ise 600 hata veriyor, 300 yapınca oluyor..

öğrenmek istediğim bunu genel bir şekle sokabilir miyiz? yada ben bu kod satırını kaldırdım ve şuanda hatasız çalışıyor, ancak başka bilgisayarlarda ve farklı yazıcı özelliklerinde bu satırın eksikliği sorun olur mu?

.PrintQuality = 300

 

[Selçuk1]

sn. cost_control;

önceki sorumdaki satır problem çıkarmadı. :mrgreen: dosyayı bugün farklı bilgisayarlarda denedim.. harika..

peki şöyle yeni bir soru sorabilir miyim?

sn. üstadlarım,

yukarıdaki kodların çalışması esnasında bu işlem oldukça uzun sürüyor. yani sayfaya sığdırma işlemi. farklı özellikteki bilgisayarlarda denedim.(bilgisayarın özelliğine göre süresi değişsede, yinede uzun bence.. )
yukarıdaki kodlarda sadeleştirme yaparak bu işlemin daha kısa sürede sonuçlandırılmasını sağlayabilirmiyiz acaba?