Sayfa numarası ekleme

[erdemzi]

Merhaba

Resimde görünen şekilde her satırın karşılığına hangi sayfada bulunduğunu yazdırmak istiyorum. Bu konuda yardımcı olabilir misiniz.
Saygılar iyi çalışmalar.

https://files.fm/u/u7nyp27jq

 

[dEdE]

Merhaba,
Ekli resim üzerinden çözüm üretmek zor.
Satır ve sütun başlıkları ve sayfa sekmelerini görsek daha kolay olurdu.
Örnek dosya hazırlayıp aynı şekilde paylaşırsanız daha çabuk yanıt alırsınız.

 

[netzone]

Merhaba,

Sayfanızda yer alan değerler sadece A-F Sütunlarında olup aşağıya doğru uzayıp gittiğini varsayıp,
Alt-üst kenar boşluklarınız, alt-üst bilgi standart ölçülerde ve kağıdınızın A4 olduğunu düşünürsek;
Office2019 Satır Yüksekliği 15 olarak (bendeki standart satır yüksekliği)
aşağıdaki makroyu bir modüle ekleyip çalıştırdığınızda F sütununa Çıktı aldığınızda tahmini kaçıncı sayfada olacağını hesaplayıp yazacaktır.
İyi çalışmalar.

Sub TumSatirlaraSayfaNumarasiYaz()
    Dim ws As Worksheet
    Dim satirYukseklik As Double
    Dim kenarBosluk As Double
    Dim ustBilgiBosluk As Double
    Dim altBilgiBosluk As Double
    Dim sayfaYukseklik As Double
    Dim satirSayisi As Long
    Dim sayfaNumarasi As Long
    Dim i As Long

    ' Çalışma sayfasını belirleyin (gerekirse değiştirin)
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa1 yerine kullanmak istediğiniz sayfa adını yazın

    ' Diğer boyutları ve sayfa bilgilerini ayarlayın
    satirYukseklik = 6.2 ' yaklaşık satır yüksekliği 15 için
    kenarBosluk = 1.9
    ustBilgiBosluk = 0.8
    altBilgiBosluk = 0.8
    sayfaYukseklik = 297 ' A4 boyutunda yükseklik
    satirSayisi = Application.WorksheetFunction.Floor((sayfaYukseklik - (ustBilgiBosluk + altBilgiBosluk)) / satirYukseklik, 1)

    ' Tüm satırlara tahmini sayfa numarasını yaz
    For i = 1 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        sayfaNumarasi = Application.WorksheetFunction.Ceiling(i / satirSayisi, 1)
        ws.Cells(i, "F").Value = sayfaNumarasi
    Next i
End Sub

 

[veyselemre]

Tüm sütunların bir sayfaya sığması halinde aşağıdaki kodu kullanabilirsiniz.

Sub test()
    Dim i&, yatay As HPageBreak, sonSat&, rw&, sf&
    sonSat = Cells(Rows.Count, 1).End(3).Row
    sf = 1
    Range("F1:F" & sonSat).Value = sf
    For Each yatay In ActiveSheet.HPageBreaks
        rw = yatay.Location.Row
        If rw > sonSat Then Exit Sub
        sf = sf + 1
        Range("F" & rw & ":F" & sonSat).Value = sf
    Next
End Sub

 

[erdemzi]

emeğinize sağlık yazdığınız kod çalışıyor.
veyselemre