Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, Cll As Cell, Par As Paragraph, sCllWdth As Single, sParWdth As Single
With ActiveDocument
  For Each Tbl In .Tables
    With Tbl
      With .Cell(1, 1)
        sCllWdth = .Width - .LeftPadding - .RightPadding
      End With
      For Each Cll In .Range.Cells
        With Cll
          .WordWrap = False
          If Len(.Range) > 2 Then
            For Each Par In .Range.Paragraphs
              With Par.Range
                sParWdth = .Characters.Last.Previous.Information(wdHorizontalPositionRelativeToPage)
                sParWdth = sParWdth - .Characters.First.Information(wdHorizontalPositionRelativeToPage)
                If sParWdth + Par.LeftIndent > sCllWdth Then .FitTextWidth = sCllWdth - Par.LeftIndent
                If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
                  .Characters.First.Information(wdVerticalPositionRelativeToPage) Then
                  .FitTextWidth = sCllWdth - Par.LeftIndent
                End If
              End With
            Next
          End If
        End With
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub