• DİKKAT

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

Soru Sayfa Alt Bilgisini Satırdan Alma

T

Turkbey41

Katılım
23 Mayıs 2018
Mesajlar
105
Excel Vers. ve Dili
2019 Türkçe
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.
 
Son düzenleme:
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.
 
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ı :(
 
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' Alıntı:
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.
Genişletmek için tıkla ...
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:
Kod: 
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
 
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.

necati' Alıntı:
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:
Kod: 
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
Genişletmek için tıkla ...
 
Dolgu rengi verme ile ilgili bir bilgi bulamadım ama sitemizden bu konuda sürpriz bir çözüm paylaşılabilir.
 
Kod: 
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?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst