CODEWITHSUNDEEP
vbaexcel
user3271518
user3271518

Reputation: 628

Printing only 50 rows per page

I have a worksheet that selects all of the cells that have been edited and prints them. I have had the print options set to fit to 1 page but when I started to print over 50 rows it was getting to small. Here is my current Code 

Dim R As Integer
On Error GoTo 1

R = Range("A65536").End(xlUp).Row

Worksheets("ACM").Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select

ActiveSheet.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlPortrait
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

I tried adding ActiveSheet.HPageBreaks.Add.Cell ("A51") to make it print only 50 rows per page but this line errors out.

So question: Is there a way to make it so I only print 50 rows one 1 page? A 2nd Question would be can I print the header on the 2nd page?

Upvotes: 0

Views: 2493

Answers (3)

user3271518
user3271518

Reputation: 628

So I couldnt get Brads suggestion to work but tinkering with ExactaBox I still couldnt get yours to work either.

So after recording macros over and over again I found this solution.

R = Range("A65536").End(xlUp).Row
ws.Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A51")
ws.PageSetup.PrintArea = Selection.Address
Application.PrintCommunication = False
With ws.PageSetup
    .PrintTitleRows = "1:1"
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlPortrait
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 0
    .PrintErrors = xlPrintErrorsDisplayed
    .ScaleWithDocHeaderFooter = True
End With
    Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

A few things to note is the change of .FitToPagesTall = 0 ' this was a 1 now its a 0

Also .PrintTitleRows = "1:1" ' this does work to print titles thank you ExactaBox

Finally 

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A51")

This is the line needed to insert a Hpagebreak above Cell 51 allowing only 50 cells on the first page.

Upvotes: 0

Brad
Brad

Reputation: 12245

Try this one. You'll need to set the sht variable to your sheet name. of just use ActiveSheet

Dim sht As Worksheet
Set sht = ActiveSheet

'this view needs to be active if you are making changes
'to the page setup which will affect printing.
ActiveWindow.View = xlPageBreakPreview

Dim bottomRow As Long, numberOfPageBreaks As Integer, p As Integer
Dim bottomRange As Range

'or set this manually if you have data with gaps in it
bottomRow = sht.Cells(1, 1).End(xlDown).Row

'minus 1 for the header row. Adjsut accordingly
numberOfPageBreaks = CInt((bottomRow - 1) / 50)

'print the first row on everypage
sht.PageSetup.PrintTitleRows = "1:1"

'start with a blank slate
sht.ResetAllPageBreaks

For p = 1 To numberOfPageBreaks
    With sht
        '+1 for the header. + another 1 for 'before'
        Set bottomRange = .Cells((50 * p) + 1 + 1, 1)
        If bottomRange.Row <= bottomRow Then
            Set .HPageBreaks(p).Location = bottomRange 
        End If

    End With
Next p

Upvotes: 0

ExactaBox
ExactaBox

Reputation: 3395

2nd question first: you can repeat headers on future pages by adding this line within your With ActiveSheet.PageSetup block: .PrintTitleRows = "$3:$3" (replace the 3's with the start and end row number of your header)

For your first question: check if you still get errors after removing 

.FitToPagesWide = 1
.FitToPagesTall = 1

from your code -- this would eliminate the logical conflict. Or try adjusting the syntax to Set ActiveSheet.HPageBreaks(1).Location = Range("B64") -- notice the .Location = Range instead of .Add.Cell (I just recorded a macro). Finally, check that the page break code is on its own line, not within the With block. Hopefully, one of these 3 suggestions will work.

Upvotes: 1

Related Questions