Yazdırma Alanı

[k0081]

Merhaba arkadaşlar;

Aşağıdaki kod ile bir tablonun yedeğini masaüstüne alıyorum.;

Dim ts, trabzonspor
Set ts = CreateObject("Wscript.Shell")
trabzonspor = ts.Specialfolders.Item("Desktop")
Sheets("SAATUCRT").Select
Range("E1:I36").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
trabzonspor & "\" & Range("E1") & ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
ActiveWindow.ScrollRow = 40
Range("E1").Select

yapmak istediğim : bu tablonun bir yazdırma alanı var.. bu yazdırma alanı ile birlikte kayıt yaptırabilirmiyim ... ?

yardımcı arkadaşa şimdiden teşekkürler..

 

[ffff7]

Application.CutCopyMode = False satırından sonra

ActiveSheet.PageSetup.PrintArea = Sheets("SAATUCRT").PageSetup.PrintArea

satırını ekleyebilirsiniz.

 

[k0081]

Application.CutCopyMode = False satırından sonra

ActiveSheet.PageSetup.PrintArea = Sheets("SAATUCRT").PageSetup.PrintArea

satırını ekleyebilirsiniz.

verdiğiniz kodu satırlar arasına kopyaladım.. Fakat istediğim sonucu vermiyor..

 

[ffff7]

O satırı

ActiveSheet.PageSetup.PrintArea = "$A$1:$E$36"

olarak değiştirin. Sanırım olacaktır.

Bu da çalışmazsa dosyanızı ekleyin.

 

[k0081]

O satırı

ActiveSheet.PageSetup.PrintArea = "$A$1:$E$36"

olarak değiştirin. Sanırım olacaktır.

Bu da çalışmazsa dosyanızı ekleyin.

Dosyayı ekledim. yani yazdırma alanı da şart değil, aslında. aynı özellikte kaydetsede olur.. sütun genişlikleri felan .. birebir aynı olsa yeterli benim için..


Ekli dosyayı görüntüle Kitap3.rar

 

[ffff7]

Worksbook.Add
ile
ActiveWorkbook.SaveAs Filename:= _
arasını

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$E$36"

şeklinde değiştirin.

 

[assenucler]

Katkılarınız için teşekkürler.

 

[k0081]

Worksbook.Add
ile
ActiveWorkbook.SaveAs Filename:= _
arasını

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$E$36"

şeklinde değiştirin.

Tamamdır.. Hocam çok teşekkürler..