Sayfaya düşen satır sayısı

[Zeki Gürsoy]

Merhaba,

Bir çalışma sayfasında kenar boşluğu veya satır yüksekliği ne olursa olsun sayfaya düşen satır sayısını bulmam gerekiyor.

Buradan da, 2.,3.,.... sayfaların ilk satır numarasını bularak aktarım yapacağım.

Yardımlarınız için şimdiden teşekkürler...

 

[Levent Menteşoğlu]

Zeki bey yanlış anlamadıysam aşağıdaki kodu deneyebilirsiniz.

ActiveSheet.HPageBreaks.Item(1).Location.Row - 1

 

[Merhum İdris SERDAR]

Default satır yüksekliğinde (12,75) ve a4 kağıdında 53.satır ve katları son satır. 53. satır ve katlarının bir fazlası diğer sayfanın başlangıç satırı.

Bu mu istediğiniz?

.

 

[Necdet]

Bilince iş başka oluyor.
Bende Levent Bey'in sonucuna ulaşmıştım.
Kodu ekleyim boşa gitmesin.

Sub test()
For i = 1 To [A65536].End(3).Row
   If Worksheets(1).HPageBreaks(1).Location <> 0 Then
        MsgBox Worksheets(1).HPageBreaks(1).Location - 1
        Exit For
    End If
Next i
End Sub

Baya uzatmışım işi

 

[Merhum İdris SERDAR]

Bir de aşağıdaki kodları deneyin. Alıntıdır.

Sub RowsToSeparatePages()

On Error GoTo ExitProcess
Dim lngRowIncrement As Long
Dim varRowSpacing As Variant
Dim varFirstRow As Variant
Dim rngRow As Excel.Range
Dim rngActual As Excel.Range
Dim rngToMove As Excel.Range


varRowSpacing = InputBox("Enter number of rows per page.", _
" Rows to Pages", "Enter here")
varRowSpacing = Abs(Val(varRowSpacing))
'If no entry then quit
If Len(varRowSpacing) = 0 Then Exit Sub
varFirstRow = InputBox("Enter the start row.", _
" Rows to Pages", "Enter here")
varFirstRow = Abs(Val(varFirstRow))

If Len(varFirstRow) = 0 Then Exit Sub

Application.ScreenUpdating = False

ActiveSheet.Copy After:=ActiveSheet
Columns("A").Insert

Set rngToMove = Range(Cells(varFirstRow, 2), _
BottomRightCorner(ActiveSheet))


For Each rngRow In rngToMove.Rows

Set rngActual = Range(rngRow.Cells(1), _
rngRow.Cells(1, rngRow.Cells.Count + 1).End(xlToLeft))
rngActual.Copy
Cells(varFirstRow + lngRowIncrement, 1).PasteSpecial Transpose:=True
lngRowIncrement = lngRowIncrement + varRowSpacing
Rows(lngRowIncrement + varFirstRow).PageBreak = xlPageBreakManual
ActiveSheet.DisplayPageBreaks = False
Next
rngToMove.Clear
ExitProcess:

On Error Resume Next
Application.CutCopyMode = False
Cells(varFirstRow, 1).Select
Application.ScreenUpdating = True
Set rngRow = Nothing
Set rngActual = Nothing
Set rngToMove = Nothing
End Sub


Function BottomRightCorner(ByRef objSheet As Worksheet) As Range
On Error GoTo NoCorner
Dim BottomRow As Long
Dim LastColumn As Long
If objSheet.FilterMode Then objSheet.ShowAllData
BottomRow = objSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
LastColumn = objSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set BottomRightCorner = objSheet.Cells(BottomRow, LastColumn)
Exit Function
NoCorner:
Beep
Set BottomRightCorner = objSheet.Cells(1, 1)
End Function


Sayfaları istediğiniz satır sayısına ayarlar.

Örnek dosya ekte.



.

 

[Zeki Gürsoy]

Default satır yüksekliğinde (12,75) ve a4 kağıdında 53.satır ve katları son satır. 53. satır ve katlarının bir fazlası diğer sayfanın başlangıç satırı.

Evet bunu arıyorum Sn yurttas yalnız, üst veya alt boşluk değiştiğinde satır sayısı azaldığından standartların dışında kullanmak istediğimde pek kullanışlı olmayacak.

Levent Bey, Necdet Bey.

Önerdiğiniz kod üzerinde deneme yaptım. İkinci sayfaya taşma olmadığında değer döndürmedi. Taşma olduğunda gerekli satır numarası dönüyor. 55 satır.(üst:2,5,alt:2,5,üst/alt bilgi:1,3, row height:12,75)

MsgBox Worksheets(1).HPageBreaks(1).Location.Row

70 satırlık 2 grup rapor listesinin 1. grup olan 40 satırını 1. sayfaya, 2. grup kalan 30 satırı ikinci sayfaya almak için 15 defa row insert yaparak sorunu şimdilik çözdüm.

Çözüm önerileriniz için ayrı ayrı teşekkür ederim.