Set border for page break

[tiredofit]

The code below determines how many rows to print:

Option Explicit

    Dim rng As Range
  
Public Sub Start()
     
    Dim Increment As Long
  
    Increment = 10 '***** CHANGE TO SUIT
  
    With Sheet1
  
        .PageSetup.PrintArea = vbNullString
      
        .ResetAllPageBreaks
  
    End With
  
    ActiveWindow.View = xlPageBreakPreview
  
    Dim Setuprng As Range
  
    With Sheet1
  
        Set Setuprng = .Range(.Cells(1, 1), .Cells(57, 9))
      
        With .PageSetup
      
            .PrintArea = Setuprng.Address
          
            .FitToPagesTall = Application.RoundUp(57 / Increment, 0)
          
            .FitToPagesWide = 1
          
            .CenterHorizontally = True
      
        End With
  
        Set Setuprng = Nothing
      
        .VPageBreaks(1).DragOff Direction:=xlToRight, _
                RegionIndex:=1
      
        .PageSetup.PrintTitleRows = "$" & 25 & ":$" & 25
  
    End With
   
    Dim Counter As Integer
  
    Counter = 1
  
    Dim Ticker As Long
  
    For Ticker = (26 + Increment) To 53 Step Increment
  
        Sheet1.HPageBreaks.Add Before:=Sheet1.Rows(Ticker)
      
        If Counter = 1 Then Set Sheet1.HPageBreaks(1).Location = Sheet1.Rows(Ticker)
      
        Counter = Counter + 1
      
        Call AddBorders(Ticker:=Ticker, Increment:=Increment)
  
    Next Ticker
  
    Dim i As Long
  
    i = 0
  
    For Ticker = 1 To 57
  
        If Sheet1.Rows(Ticker).PageBreak <> xlPageBreakNone Then
      
            i = i + 1
      
            If (Ticker - 26) Mod Increment <> 0 Then Sheet1.HPageBreaks(i).Delete
      
        End If
  
    Next Ticker
  
    ActiveWindow.View = xlNormalView
  
    Sheet1.PrintOut Preview:=xlYes
  
    Dim SaveFile As Variant
  
    With ThisWorkbook
  
        SaveFile = Application.GetSaveAsFilename(InitialFileName:=Left(String:=.FullName, _
                                                 Length:=(InStrRev(StringCheck:=.FullName, _
                                                 StringMatch:=".", _
                                                 Start:=-1, _
                                                 Compare:=vbTextCompare) - 1)) & ".pdf", _
                                                 FileFilter:="PDF files, *.pdf", _
                                                 Title:="Save workbook as pdf")
  
    End With
  
    If SaveFile <> False Then Sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
                                                         Filename:=SaveFile, _
                                                         Quality:=xlQualityStandard, _
                                                         IncludeDocProperties:=True, _
                                                         IgnorePrintAreas:=False, _
                                                         OpenAfterPublish:=True
                      
    Call RemoveBorders
   
    With Sheet1
  
        .PageSetup.PrintArea = vbNullString
      
        .ResetAllPageBreaks
  
    End With
         
End Sub

This Sets the borders:

Private Sub AddBorders(ByRef Ticker As Long, ByRef Increment As Long)
  
    With Sheet1

        Set rng = .Range(.Cells(Ticker - 1, 2), .Cells(Ticker - 1, 8))

    End With

    With rng

        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone

        With .Borders(xlEdgeLeft)

            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium

        End With
  
        .Borders(xlEdgeTop).LineStyle = xlNone
      
        With .Borders(xlEdgeBottom)

            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium

        End With

        With .Borders(xlEdgeRight)

            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium

        End With

        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone

    End With

End Sub

This removes them:

Private Sub RemoveBorders()

    With Sheet1
          
        Set rng = .Range(.Cells(26, 2), .Cells(26 + 26 - 1, 8))
  
    End With
  
    With rng

        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
      
        With .Borders(xlEdgeLeft)
      
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
          
        End With
      
        With .Borders(xlEdgeTop)
      
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
          
        End With
      
        With .Borders(xlEdgeBottom)
      
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
          
        End With
      
        With .Borders(xlEdgeRight)
      
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
          
        End With
      
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone

    End With
  
End Sub

The variable Increment is currently set to 10.

This sets a page break after every 10th row. The exception is the first page because there are 25 rows of info.

Note for every page, row 25 is also printed, as determined by this line of code:

.PageSetup.PrintTitleRows = "$" & 25 & ":$" & 25

Here is the setup:

Rows 1 to 25 are info.
Data starts from row 26 through to row 51 (26 rows in total).
Rows 52 to 57 also contain info.

Row 25 contains top and bottom borders.

Row 52 also contains top and bottom borders.

The problem is if I set Increment to be any value OTHER than 1, the top and bottom borders exist for every page, as I want.

However, if I set Increment to 1, the bottom border is omitted on every page.

Can someone tell me why that is the case?

Thanks

 

[Monty Norman]

Hello @tiredofit

Sorry!!! I did not read the long message that you posted! It is always best to give enough just for us to understand your issue.

If you have the code that "The code below determines how many rows to print:" why can't you add 1 to that and make the row+1 Top border and that simulates what you are trying to achieve as per the photo you posted?

Monty

 

[tiredofit]

Hello @tiredofit

Sorry!!! I did not read the long message that you posted! It is always best to give enough just for us to understand your issue.

If you have the code that "The code below determines how many rows to print:" why can't you add 1 to that and make the row+1 Top border and that simulates what you are trying to achieve as per the photo you posted?

Monty

I think if I did that, it would work for 1 but not any other value.

Nevertheless, I managed to find a workaround.

If the user chooses 1, I have added some code to add borders to every row in the area to print.