Заранее премного балгодарна....

Модератор: Naeel Maqsudov
Код: Выделить всё
Sub test()
Dim p As Paragraph, w As Range
For Each p In ActiveDocument.Paragraphs
If p.Range.ComputeStatistics(wdStatisticWords) > 1 Then
WordsCount = 0
For Each w In p.Range.Words
[B]If w.Characters.Count > 4 Then[/B] WordsCount = WordsCount + 1
Next
p.Range.InsertAfter WordsCount & vbNewLine
End If
Next
End Sub