• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel'de aynı sayfa içinde dikey ve yatay olur mu?

P

potifar534

Katılım
5 Mart 2017
Mesajlar
105
Excel Vers. ve Dili
Excel 2021 Tr
Merhabalar!
Bir çalışmamda aynı sayfadaki birinci sayfayı dikey, ikinci sayfayı yatay kullanmam icap etti.
Uğraştım fakat konuyu çözemedim.
İnternetten araştırdım sanırsam böyle bir şey yok.
Konuyu bilen arkadaşlardan bu özelliğin olup olmadığı hakkında bilgi vermelerini rica ederim.
 
Ekli dosyayı deneyiniz.

http://s6.dosya.tc/server8/6f79du/YATAY_DIKEY_YAZDIR.zip.html

Kod: 
Sub menu()
  Application.DisplayAlerts = False
   Call dikey_yazdir("A1:I50")
   Call dikey_yazdir("J1:R50")
   Call dikey_yazdir("J51:R100")
   Call dikey_yazdir("A101:I150")
   Call dikey_yazdir("J101:R150")
   Call yatay_yazdir("A51:I100")
  Application.DisplayAlerts = True
End Sub

Sub dikey_yazdir(alan)
    Range(alan).Select
    ActiveSheet.PageSetup.PrintArea = alan
    If Application.Version >= 14 Then Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    If Application.Version >= 14 Then Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = alan
    If Application.Version >= 14 Then Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .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
    If Application.Version >= 14 Then Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Range("F8").Select
End Sub

Sub yatay_yazdir(alan)
    Range(alan).Select
    ActiveSheet.PageSetup.PrintArea = alan
    If Application.Version >= 14 Then Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    If Application.Version >= 14 Then Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = alan
    If Application.Version >= 14 Then Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .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
    If Application.Version >= 14 Then Application.PrintCommunication = True
    If Application.Version >= 14 Then Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    If Application.Version >= 14 Then Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = alan
    If Application.Version >= 14 Then Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 0
        .FitToPagesTall = 1
        .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
    If Application.Version >= 14 Then Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Range("E65").Select
End Sub
 
Son düzenleme:
selamlar

Kod: 
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)

bunlar kenar boşlukları ve alt bilgi üst bilgi mi
 
potifar534' Alıntı:
selamlar

Kod: 
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
bunlar kenar boşlukları ve alt bilgi üst bilgi mi
Genişletmek için tıkla ...

Yazıcı ayarlarında "Özel kenar boşluklarının "tanımlandığı alanlar.
 
asri hocam sizi daha fazla uğraştırmayayım. kodu daha sonra inceletirim. yine aynı hatayı verdi.
bende Excel 2016 kurulu.
kod için teşekkürler.
 
potifar534' Alıntı:
asri hocam sizi daha fazla uğraştırmayayım. kodu daha sonra inceletirim. yine aynı hatayı verdi.
bende Excel 2016 kurulu.
kod için teşekkürler.
Genişletmek için tıkla ...

Profilinizde 2010 yazıyor :)

Koddaki If Application.Version >= 14 Then Application.PrintCommunication satırları silip deneyin.

Bende office 2010 mevcut.
 
"PageSetup sınıfının PrintQuality özelliği kurulamıyor."
HATASI VERDİ.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst