Soru Sayfa yazdırırken sayfa taştığında sayfa düzenini sığdır

[ASLAN7410]

Merhaba herkese hayırlı akşamlar.

Ekte gönderdiğim excel dosyamda yazdırma butonu mevcut, sayfanın H sütunundaki verilere göre (metin içerikleri alıntıdır) hücre aralığı genişleyip daralmaktadır. A1 ile H72 hücreleri arası yazdırma alanı mevcut, butona bastığımda boş satırlar gizleniyor ve dolu olan satırlar yazdırılıyor. Buraya kadar bir sıkıntı yok.

H sütunundaki bilgilere göre hücre daralıp genişlediği için bazen sayfa taşmakta 2.sayfaya yazdırmaktadır. Veriler 1.sayfadan taştığında 2.sayfaya yazdırıyor. Veriler şekilsiz taştığı için 2.sayfaya yazdırıyor. Örneğin 71. ve 72. satırları 1.sayfadan taştığında 2.sayfaya yazdırıyor, bu da şekilsiz bir görüntü olarak çıktı oluyor.

Yapmak istediğim, butonla yazdırmak istediğim de 66.satırdan sonrası 2.sayfaya taşarsa sayfa otomatik olarak tek sayfaya sığdırarak yazdırsın.

Yardımcı olur musunuz?

Yazdırdığım çıktı örneklerini de ekliyorum.

 

[ASLAN7410]

Arkadaşlar konu günceldir.

Yardımcı olur musunuz?

 

[ASLAN7410]

Arkadaşlar konu günceldir.
Bu istediğim gibi bir şey olabilir mi?
Yorum yapacak yardımcı olacak kimse yok mu?

 

[leumruk]

Selamlar,
Yazdırma makronuzun,

ActiveWindow.SelectedSheets.PrintOut Copies:=yazdir, Collate:=True, _
IgnorePrintAreas:=False

satırını eklediğim kodla değiştirin.

'-----Eğer 2. sayfaya taşmış ise satırları tek sayfaya sığdır-------
On Error Resume Next
With ActiveSheet.PageSetup
   .Zoom = 100
    If ActiveSheet.PageSetup.Pages.Count = 2 Then
        .Zoom = False
        .FitToPagesWide = 0
        .FitToPagesTall = 1
    End If
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=yazdir, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.PageSetup.Zoom = 100
Err.Clear
'--------------------------------------------------------------------

 

[ASLAN7410]

Sayın lemruk, ilginiz için çok teşekkür ediyorum.

Yazmış olduğunuz kodlar gayet güzel çalışıyor, ellerinize sağlık çok teşekkür ediyorum.
Gönderdiğim şablondaki örneğin 50 satıra kadar bilgi doldurulduğunda taşan sayfalar hepsi tek sayfaya sığdığı için yazılar çok küçük oluyor ve okunmuyor.

Benim istediğim 66.satırdan sonrası 2.sayfaya taşarsa sayfa otomatik olarak tek sayfaya sığdırarak yazdırsın. 66. satırdan önceki satırlar 2.sayfaya taşarsa otomatik sığdırma iptal olsun 2 sayfa veya 3 sayfa yazdırsın istiyorum.

 

[leumruk]

Selamlar,

'-----Eğer 2. sayfaya taşmış ise satırları tek sayfaya sığdır-------
On Error Resume Next
With ActiveSheet.PageSetup
   .Zoom = 100
    If ActiveSheet.PageSetup.Pages.Count = 2 Then
      If ActiveSheet.HPageBreaks(1).Location.Row <= 66 Then
        .Zoom = False
        .FitToPagesWide = 0
        .FitToPagesTall = 1
      End If
    End If
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=yazdir, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.PageSetup.Zoom = 100
Err.Clear
'--------------------------------------------------------------------

Bu kodla istediğiniz gerçekleşiyor, ancak bazen If ActiveSheet.HPageBreaks(1).Location.Row <= 66 Then satırı hata veriyor. Sebebini çözemedim. Bu satırla 2. sayfanın ilk satırını buluyorum. Bu satıra alternatif bulabilirseniz daha sağlıklı olabilir. Hata satırını tırnaklayıp farklı metin girişleriyle deneme yapınız.

 

[ASLAN7410]

Sayın Mustafa Bey aleykümselam, ellerinize sağlık çok teşekkür ediyorum, kodlar tam istediğim gibi çalışıyor, dediğiniz yerde bende hata vermedi.
Kodları evdeki bilgisayarda denedim gayet güzel çalışıyor, kodları iş yerinde orijinal program içerisinde denediğim de geri dönüş yaparım.

Dediğiniz yer nasıl bir hata veriyordu acaba?

Hayırlı günler diliyorum.

 

[leumruk]

Rica ederim.
"Run Time Error 9" hatası alıyordum. Belki satırlar gizlendiğinde sayfa sayısının düşmesiyle alakalıdır. Son denemelerimde bir sorun yaşamadım.

 

[ASLAN7410]

Sayın Mustafa Bey kodları orijinal dosyamda denedim, sayfanın tamamını doldurdum hep sayfa küçülerek 1 sayfa çıktı aldım.

Benim istediğim,
eğer 66. satır ve sonrası 2.sayfaya taşarsa sayfa otomatik olarak tek sayfaya sığdırarak yazdırsın,
eğer 65. satır ve önceki satırlar 2.sayfaya taşarsa otomatik sığdırma iptal olsun normal yazdırsın istiyorum.

 

[leumruk]

Selamlar, 6. mesajımdaki kodu yeniden düzenledim. ActiveSheet.HPageBreaks(1).Location.Row <= 66

 

[ASLAN7410]

Aleykümselam Sayın Mustafa Bey, hayırlı akşamlar.

Kodu yine kendi orijinal sayfamda denedim, bütün hücreleri doldurdum, hala aynı şekilde küçülterek tek sayfada çıkartıyor.

Benim istediğim,
eğer 66. satır ve sonrası 2.sayfaya taşarsa tek sayfaya sığdırarak yazdırsın,
eğer 65. satır ve önceki satırlar 2.sayfaya taşarsa sığdırma iptal olsun normal yazdırsın istiyorum.

 

[leumruk]

Bu kodu tek başına dener misiniz? Bende işyerinde hata vermiyor, evde hata veriyor. Eğer hata alırsanız sorun bu satırdan kaynaklanıyor. Bu satıra çözüm aramamız gerekecek.

 

[ASLAN7410]

Mustafa Bey, kod hata vermiyor, sizin dediğiniz gibi kodu tek başına denedim, sayfa taştığı halde aynı şekilde küçülterek tek sayfada çıkartıyor.

 

[leumruk]

Kodu eklememişim.
Bu kodu deneyiniz, cevabınıza göre çözüm bulacağım.

Sub Dene()
MsgBox ActiveSheet.HPageBreaks(1).Location.Row
End Sub

 

[ASLAN7410]

Mustafa Bey, en son kodu denedim, bütün satırlar açıkken 24 mesajı ekrana geliyor, kontrol ettiğimde 24.satırın 2.sayfaya taştığını gördüm, benim ilk mesajımda gönderdiğim örnekte boş satırlar gizli şekildeyken bu kodu çalıştırdığımda debug hatası veriyor.

 

[leumruk]

Hata aldığınız durumdayken aşağıdaki kodu deneyip dönüş yapar mısınız?

Sub Dene()
Application.ScreenUpdating = False
ActiveWindow.View = xlPageBreakPreview
MsgBox ActiveSheet.HPageBreaks(1).Location.Row
ActiveWindow.View = xlNormalView
End Sub

 

[ASLAN7410]

Mustafa Bey, 24 mesajı ekrana geliyor.

 

[leumruk]

Sanırım sorun çözüldü. Kodu bu şekilde deneyiniz:

'-----Eğer 2. sayfaya taşmış ise satırları tek sayfaya sığdır-------
On Error Resume Next
Application.ScreenUpdating = False
With ActiveSheet.PageSetup
   .Zoom = 100
    If ActiveSheet.PageSetup.Pages.Count = 2 Then
    ActiveWindow.View = xlPageBreakPreview
      If ActiveSheet.HPageBreaks(1).Location.Row <= 65 Then
        .Zoom = False
        .FitToPagesWide = 0
        .FitToPagesTall = 1
      End If
    ActiveWindow.View = xlNormalView
    End If
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=yazdir, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.PageSetup.Zoom = 100
Err.Clear
'--------------------------------------------------------------------

 

[ASLAN7410]

Sayın Mustafa Bey, yanlış anlamayın ama valla aynı sonucu alıyorum.

Elimdeki orijinal örnekte 24.satır 2.sayfada bulunuyor. Bazen H sütunundaki bilgilere göre satırlar genişleyip daraldığı için denediğim örnekte 24.satır 2.sayfada bulunuyor.

Acaba 65.satır ve 66.satır 2.sayfada bulunduğu için mi bu şekilde küçülterek sayfayı tek sayfada yazdırıyor.

 

[leumruk]

Benim istediğim,
eğer 66. satır ve sonrası 2.sayfaya taşarsa tek sayfaya sığdırarak yazdırsın,

Bu cümle sizin. … üst mesajlardan aldım.

Acaba 65.satır ve 66.satır 2.sayfada bulunduğu için mi bu şekilde küçülterek sayfayı tek sayfada yazdırıyor.

Aynen söylediğiniz sebepten dolayı tek sayfaya sığdırıyor.
Örneğin koddaki 65 ifadesini 25 olarak değiştirip deneyin. Sorun kalmadığını göreceksiniz.