Make page length more uniform/improve the bottom line in Word

Word-bottom-border-consistent.vba

' License: GNU GPL v3 or later
' Related: https://web.archive.org/web/20210329112712/http://wordfaqs.ssbarnhill.com/BottomLine.htm

' Usage: function names should be easy to understand. The functions/subs that take parameters are internal helper functions.

' Reference: TODO add reference

Private Declare PtrSafe Function MessageBoxW Lib "User32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long

Sub ChangeLineSpacing(ByVal delta As Integer, ByVal undorecordname As String)
    Dim objUndo As UndoRecord
    Set objUndo = Application.UndoRecord
    objUndo.StartCustomRecord (undorecordname)
    For Each p In Selection.Range.Paragraphs
        With p.Range.ParagraphFormat
            .LineSpacingRule = wdLineSpaceExactly
            If .LineSpacing <> wdUndefined Then
                .LineSpacing = .LineSpacing + delta
            End If
        End With
    Next
    objUndo.EndCustomRecord
End Sub
Sub IncreaseLineSpacing()
    ChangeLineSpacing 1, "IncreaseLineSpacing"
End Sub
Sub DecreaseLineSpacing()
    ChangeLineSpacing -1, "DecreaseLineSpacing"
End Sub


Sub SnapTableCell()
    If Not Selection.Information(wdWithInTable) Then
        MsgBox "Cannot find table"
        Exit Sub
    End If
    If Selection.Rows.Count <> 1 Then
        MsgBox "Select exactly one cell."
        Exit Sub
    End If
    
    Dim cell As cell
    Set cell = Selection.Cells(1)
    If Not CellIsEnd(cell) Then
        MsgBox "Invalid cell."
        Exit Sub
    End If
    
    cell.SetHeight RowHeight:=(Selection.PageSetup.PageHeight - _
        Selection.PageSetup.BottomMargin - _
        cell.Range.Information(wdVerticalPositionRelativeToPage) _
        - 2), HeightRule:=wdRowHeightAtLeast
End Sub

Sub UnheightTableCell()
    Selection.Rows.HeightRule = wdRowHeightAuto
End Sub


Function CellIsEnd(ByVal cell As cell) As Boolean
    ' either end of table, or (start portion is) end of current page
    Dim cellBelowStartRange As Range
    
    Dim row As Integer
    row = cell.RowIndex
    
    Dim cellEndPageNumber As Integer
    cellEndPageNumber = cell.Range.Information(wdActiveEndPageNumber)
    
    If ActiveDocument.Range(cell.Range.Start, cell.Range.Start) _
            .Information(wdActiveEndPageNumber) <> cellEndPageNumber _
            Then
        CellIsEnd = True
        Exit Function
    End If

    If row = cell.Column.Cells.Count Then
        CellIsEnd = True
        Exit Function
    End If
    
    Dim cellBelow As cell
    Set cellBelow = cell.Column.Cells(row + 1)

    CellIsEnd = cellEndPageNumber <> _
        ActiveDocument.Range(cellBelow.Range.Start, cellBelow.Range.Start) _
        .Information(wdActiveEndPageNumber)
End Function



Sub HideLastPage()
    ' CS9
    'Selection.EndKey Unit:=wdStory
    'Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    ActiveWindow.View.ShowHiddenText = False
    With ActiveDocument
        Selection.SetRange .Content.End - 1, .Content.End
        Selection.Font.Hidden = True
        '.Range(.Content.End - 1, .Content.End).Font.Hidden = True
    End With
End Sub
Sub UnhideLastPage()
    ActiveWindow.View.ShowHiddenText = False
    With ActiveDocument
        Selection.SetRange .Content.End - 1, .Content.End
        Selection.Font.Hidden = False
        ' .Range(.Content.End - 1, .Content.End).Font.Hidden = False
    End With
End Sub

NOTE CellIsEnd may raise error if the table has merged cells.