Soru Sayfa Alt Bilgisini Satırdan Alma

[Turkbey41]

Merhaba,

89-90-91 numaralı satırlarının alt bilgi olarak çıktı alınan tüm sayfalarda olmasını istiyorum. Bunu nasıl sağlayabilirim. Sayfa uzunluğu diğer sayfalara taşsa bile bu satırların çıktı alırken tüm sayfalarda alt bilgi olarak çıktı olmasını istiyorum.

Sayfa adı : Sayfa1

Örnek Dosya : ornek-dosya-2.xlsm - 16 KB

Teşekkürler.

 

[cems]

Excel'de belirli satırları her yazdırılan sayfanın altına (footer) eklemek için doğrudan bir özellik bulunmamaktadır. Ancak, bunu yapmak için bir makro kullanabilirsiniz. Aşağıda, "Sayfa1" sayfasında 89-91 numaralı satırları her sayfanın altına ekleyen bir VBA makrosu örneği yer alıyor.
Adımlar:

1. VBA Düzenleyicisini Açın:
   • Alt + F11 tuşlarına basarak VBA düzenleyicisini açın.
   • Insert menüsünden Module seçeneğini seçerek yeni bir modül ekleyin.
2. VBA Kodunu Girin:
   • Aşağıdaki kodu modül penceresine yapıştırın:
3. 
   Sub PrintWithFooter()
   Dim ws As Worksheet
   Dim rngFooter As Range
   Dim lastRow As Long
   Dim i As Long, j As Long
   Dim pageHeight As Long
   Dim pageWidth As Long
   
   ' Sayfa1 sayfasını ayarlayın
   Set ws = ThisWorkbook.Sheets("Sayfa1")
   Set rngFooter = ws.Rows("89:91")
   
   ' Yazdırma alanını ayarlayın
   ws.PageSetup.PrintArea = ws.UsedRange.Address
   
   ' Yazdırma alanındaki satır sayısını al
   lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
   
   ' Sayfa boyutlarını ayarlayın (normalde sayfa başına satır sayısı yaklaşık olarak belirlenir)
   pageHeight = 50 ' Her sayfada yaklaşık satır sayısı (dinamik ayarlarla optimize edilebilir)
   
   ' Geçici satırları ekleyin
   For i = pageHeight To lastRow Step pageHeight
   ' Eğer mevcut sayfanın satır sayısı dolmuşsa, footer satırlarını ekleyin
   rngFooter.Copy
   ws.Rows(i + 1).Insert Shift:=xlDown
   Application.CutCopyMode = False
   Next i
   
   ' Yazdırma işlemini gerçekleştir
   ws.PrintOut
   
   ' Eklenmiş satırları geri alın
   For j = lastRow To pageHeight Step -pageHeight
   ws.Rows(j + 1).Resize(rngFooter.Rows.Count).Delete
   Next j
   End Sub
4. Makroyu Çalıştırın:
   • VBA düzenleyicisinde F5 tuşuna basarak makroyu çalıştırabilirsiniz.
   • Bu makro, Sayfa1 üzerindeki 89-91 numaralı satırları geçici olarak her yazdırılan sayfanın altına ekleyip, yazdırma işlemi tamamlandığında bu eklenmiş satırları geri alır.

Notlar:

• pageHeight değişkeni her sayfada kaç satır olacağını yaklaşık olarak belirler. Bu değeri belgeye uygun olarak ayarlayabilirsiniz.
• Makro, yazdırma işlemi sırasında sayfanın sonuna geçici olarak satır ekleyip sonra bu satırları kaldırır, bu nedenle normal verilerinizde herhangi bir değişiklik olmaz.

Bu makroyu çalıştırdığınızda, belirttiğiniz satırlar her yazdırılan sayfanın sonunda otomatik olarak görünecektir. Çoklu orijinal dosyadaki çoklu sayfada degil bir kac sayfalık bir kopya dosyada deneme ve düzeltmeler yapmanız daha dogru olabilir.

 

[Turkbey41]

Hocam teşekkürler ama satır sayısından dolayı kayma olduğunda ilgili satırlar sonraki sayfada üstte çıkıyor. Talebimi karşılamadı

 

[cems]

Ayar ve sayfa satır sayılarına dikkat ettiğinizi ve uyarladıgınızı düşünüyorum. Dosya ozel anladıgım kadarı ile ama olmayan dosya ile destek daha fazla olmayabilir

 

[Turkbey41]

Merhaba,

Örnek dosya linki aşağıdaki gibidir.

Şimdiden teşekkür ederim.

Örnek Dosya : ornek-dosya-2.xlsm - 16 KB

 

[necati]

Merhaba,
89-90-91 numaralı satırlarının alt bilgi olarak çıktı alınan tüm sayfalarda olmasını istiyorum. Bunu nasıl sağlayabilirim. Sayfa uzunluğu diğer sayfalara taşsa bile bu satırların çıktı alırken tüm sayfalarda alt bilgi olarak çıktı olmasını istiyorum.
Teşekkürler.

Merhaba, Bu 3 satırı başka bir konuma alsanız ve oradan excel'in kendi alt bilgi alanı olarak ekleseniz daha iyi olmaz mı? Mesela alt bilgi satırlarının K1,K2,K3 de olduğunu varsayarsak:

Sub alt_bilgi_koy()
Dim altbilgi
altbilgi = Range("K1").Value & Chr(10) & Range("K2").Value & Chr(10) & Range("K3").Value
Application.ActiveSheet.PageSetup.CenterFooter = altbilgi
ActiveSheet.PrintPreview
End Sub

 

[Turkbey41]

Hocam teşekkür ederim. Bu kod şuan istediğimi sağladı ama sorun şu K1 hücresine dolgu yapıyorum ama dolgu rengi alt bilgi alanında çıkmıyor.

Merhaba, Bu 3 satırı başka bir konuma alsanız ve oradan excel'in kendi alt bilgi alanı olarak ekleseniz daha iyi olmaz mı? Mesela alt bilgi satırlarının K1,K2,K3 de olduğunu varsayarsak:

Sub alt_bilgi_koy()
Dim altbilgi
altbilgi = Range("K1").Value & Chr(10) & Range("K2").Value & Chr(10) & Range("K3").Value
Application.ActiveSheet.PageSetup.CenterFooter = altbilgi
ActiveSheet.PrintPreview
End Sub

 

[necati]

Dolgu rengi verme ile ilgili bir bilgi bulamadım ama sitemizden bu konuda sürpriz bir çözüm paylaşılabilir.

 

[zpawnz]

Sub alt_bilgi_koy() 
   Dim altbilgi As String 
   altbilgi = Range("K1").Value & Chr(10) & Range("K2").Value & Chr(10) & Range("K3").Value 
   Dim cellColor1 As Long, cellColor2 As Long, cellColor3 As Long 
   cellColor1 = Range("K1").Interior.Color 
   cellColor2 = Range("K2").Interior.Color 
   cellColor3 = Range("K3").Interior.Color 
   Dim footerHTML As String 
   footerHTML = "<font color='" & RGB2HTML(cellColor1) & "'>" & Range("K1").Value & "</font><br>" 
   footerHTML = footerHTML & "<font color='" & RGB2HTML(cellColor2) & "'>" & Range("K2").Value & "</font><br>" 
   footerHTML = footerHTML & "<font color='" & RGB2HTML(cellColor3) & "'>" & Range("K3").Value & "</font>" 
   Application.ActiveSheet.PageSetup.CenterFooter = footerHTML 
    ActiveSheet.PrintPreview 
End Sub 
 Function RGB2HTML(rgb As Long) As String 
   Dim r As Long, g As Long, b As Long 
   r = rgb Mod 256 
   g = (rgb \ 256) Mod 256 
   b = rgb \ 65536 
   RGB2HTML = "#" & Right("00" & Hex(r), 2) & Right("00" & Hex(g), 2) & Right("00" & Hex(b), 2) 
End Function

Dener misiniz?