Hi Christine,
Another version for you to try:
Code:
Sub PartPrint()
Application.ScreenUpdating = False
Dim RngPrn As Range, RngSel As Range, oTbl As Table, oCel As Cell, i As Long
With ActiveDocument
Set RngSel = Selection.Range
Set RngClr = .GoTo(What:=wdGoToPage, Name:=RngSel.Characters.First.Information(wdActiveEndPageNumber))
Set RngClr = RngClr.GoTo(What:=wdGoToBookmark, Name:="\page")
With RngPrn
.End = RngSel.Start
.Font.Color = wdColorWhite
If RngSel.Characters.First.Information(wdWithInTable) = True Then
For Each oTbl In RngPrn.Tables
If oTbl.Range.End < RngSel.Tables(RngSel.Tables.Count).Range.End Then
For Each oCel In oTbl.Range.Cells
For i = 1 To oCel.Borders.Count
oCel.Borders(i).Color = wdColorWhite
Next
Next
Else
For Each oCel In oTbl.Range.Cells
If oCel.Row.Index < RngSel.Rows.First.Index Then
For i = 1 To oCel.Borders.Count
oCel.Borders(i).Color = wdColorWhite
Next
End If
Next
End If
Next
Else
For Each oTbl In RngPrn.Tables
For Each oCel In oTbl.Range.Cells
For i = 1 To oCel.Borders.Count
oCel.Borders(i).Color = wdColorWhite
Next
Next
Next
End If
Application.PrintOut Range:=wdPrintCurrentPage
End With
While RngPrn.Font.Color = wdColorWhite
.Undo
Wend
RngSel.Select
End With
Application.ScreenUpdating = True
End Sub