Add border top and bottom row for all pages

[elsuji]

Hi,

I have excel file which is the list of details entered.

I write the code for automatically do the page brake and bordering to top and bottom row of all the pages .

My code is

Sub Calibration_Certificate_Printout()




'For page breake setup


Dim ws As Worksheet, Rg As Range, LastRow1 As Long, Count As Long ', ii As Long


ii = 44 ' first page break
Set ws = ActiveSheet


With ws
LastRow1 = .Range("B" & .rows.Count).End(xlUp).Row
Count = LastRow1
Set Rg = .Range("B4", "G" & Count) 'The range of the document


If LastRow1 > 30 Then ' count is the number of row. Break at every 15 rows
.ResetAllPageBreaks
.PageSetup.PrintArea = Rg.Address


While Count > 0 And ii < LastRow1
If Count > 40 Then ' no page break if there is less than 15 rows left
'.Rows(ii).PageBreak = xlPageBreakManual
.HPageBreaks.Add Before:=.rows(ii)

End If
ii = ii + 40
Count = Count - 40
Wend
End If


'For alignment


Dim i As Long
For i = 1 To ActiveSheet.HPageBreaks.Count
With Range(ActiveSheet.HPageBreaks(i).Location.Address).Offset(-1).Resize(, 7).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Next i
End With
End Sub




with this code, while taking print the border is not updating for first row of all pages.


Can any one please help to this

The file is attached here

[jolivanes]

Could you please put your code between code tags.
Makes it a lot more pleasant to read.
Highlight your code and click on the # at the top of the window.

[elsuji]

My code is

#################################################
Sub Calibration_Certificate_Printout()
'For page breake setup

Dim ws As Worksheet, Rg As Range, LastRow1 As Long, Count As Long ', ii As Long
ii = 44 ' first page break
Set ws = ActiveSheet
With ws
LastRow1 = .Range("B" & .rows.Count).End(xlUp).Row
Count = LastRow1
Set Rg = .Range("B4", "G" & Count) 'The range of the document
If LastRow1 > 30 Then ' count is the number of row. Break at every 15 rows
.ResetAllPageBreaks
.PageSetup.PrintArea = Rg.Address
While Count > 0 And ii < LastRow1
If Count > 40 Then ' no page break if there is less than 15 rows left
'.Rows(ii).PageBreak = xlPageBreakManual
.HPageBreaks.Add Before:=.rows(ii)
End If
ii = ii + 40
Count = Count - 40
Wend
End If


'For alignment
Dim i As Long
For i = 1 To ActiveSheet.HPageBreaks.Count
With Range(ActiveSheet.HPageBreaks(i).Location.Address).Offset(-1).Resize(, 7).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next i
End With
End Sub
#################################################

[Kenneth Hobs]

The tags are inserted by clicking the # icon on the reply toolbar. OR, type them: (code)your code here(/code) but replace ()'s with []'s.

[elsuji]

I am not clear on ur reply. Can you explain please

[elsuji]

Sub Calibration_Certificate_Printout()
'For page breake setup

Dim ws As Worksheet, Rg As Range, LastRow1 As Long, Count As Long ', ii As Long
ii = 44 ' first page break
Set ws = ActiveSheet
With ws
LastRow1 = .Range("B" & .rows.Count).End(xlUp).Row
Count = LastRow1
Set Rg = .Range("B4", "G" & Count) 'The range of the document
If LastRow1 > 30 Then ' count is the number of row. Break at every 15 rows
.ResetAllPageBreaks
.PageSetup.PrintArea = Rg.Address
While Count > 0 And ii < LastRow1
If Count > 40 Then ' no page break if there is less than 15 rows left
'.Rows(ii).PageBreak = xlPageBreakManual
.HPageBreaks.Add Before:=.rows(ii)
End If
ii = ii + 40
Count = Count - 40
Wend
End If


'For alignment
Dim i As Long
For i = 1 To ActiveSheet.HPageBreaks.Count
With Range(ActiveSheet.HPageBreaks(i).Location.Address).Offset(-1).Resize(, 7).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next i
End With
End Sub

[elsuji]

Hi can you pls help me how to do this