Удаление пустых абзацев в ячейках таблиц (MS Word)

Sub RemoveBlankParagraphs()
' Удаление пустых параграфов во всех ячейках всех таблиц документа
' https://www.programmersforum.ru/showthread.php?t=346549
' -------------------------------------------------------------------------------------------------/
Dim objDoc As Document, objRange As Range, objRangeP As Range
Dim objTable As Table, objCell As Cell, objParagraph As Paragraph
Dim iVal%
' -------------------------------------------------------------------------------------------------/
On Error GoTo RemoveBlankParagraphs_Err

    Set objDoc = ActiveDocument
    iVal = objDoc.Tables.Count

    If iVal = 0 Then ' no point if there are no tables
        MsgBox "Документ не содержит таблиц!", vbExclamation
        GoTo RemoveBlankParagraphs_End
    End If
    
    iVal = 0
    For Each objTable In objDoc.Tables
        For Each objCell In objTable.Range.Cells
            Set objRange = objCell.Range
            For Each objParagraph In objRange.Paragraphs
                Set objRangeP = objParagraph.Range
                If Trim(objRangeP.Text) = vbCr Then
                    objRangeP.Delete
                    iVal = iVal + 1
                End If
            Next objParagraph
        Next objCell ' к следующей ячейке
    Next objTable    ' goes to next table

    If iVal > 0 Then
        MsgBox "Удалено: " & iVal & " пустых параграфов в ячейках таблиц.", vbInformation, "Info"
    Else
        MsgBox "Пустых параграфов в ячейках таблиц не найдено.", vbInformation, "Info"
    End If
    
RemoveBlankParagraphs_End:
    On Error Resume Next
    Set objParagraph = Nothing
    Set objRangeP = Nothing
    Set objRange = Nothing
    Set objCell = Nothing
    Set objTable = Nothing
    Set objDoc = Nothing

    Err.Clear
    Exit Sub

RemoveBlankParagraphs_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub :" & _
        "RemoveBlankParagraphs - ThisDocument.", vbCritical, "Error!"
    Err.Clear
    Resume RemoveBlankParagraphs_End
End Sub