Перебирать абзацы и обрезать пробелы в MS Word

Question

Мне нужно создать макрос, который удаляет пробелы и отступ перед всеми абзацами в активном документе MS Word. Я пробовал следующее:

For Each p In ActiveDocument.Paragraphs
    p.Range.Text = Trim(p.range.Text)
Next p

, который устанавливает макросы в вечный цикл. Если я пытаюсь присвоить строковый литерал абзацам, vba всегда создает только 1 абзац:

For Each p In ActiveDocument.Paragraphs
    p.Range.Text = "test"
Next p

Я думаю, что у меня есть общее неправильное представление об объекте абзаца. Я был бы признателен за любую информацию по этому вопросу.

Answer 1

Причина, по которой код в вопросе зацикливается, заключается в том, что замена одного абзаца обработанным (обрезанным) текстом приводит к изменению коллекции абзацев.Таким образом, код будет постоянно обрабатывать один и тот же абзац в какой-то момент.

Это нормальное поведение с объектами, которые удаляются и воссоздаются "за сценой".Чтобы обойти это, нужно зациклить коллекцию от конца до фронта:

For i = ActiveDocument.Paragraphs.Count To 1 Step -1
    Set p = ActiveDocument.Paragraphs(i)
    p.Range.Text = Trim(p.Range.Text)
Next

Тем не менее, если абзацы в документе содержат какое-либо форматирование, это будет потеряно.Обработка строк не сохраняет форматирование.

Альтернативой может быть проверка первого символа каждого абзаца для типов символов, которые вы считаете «пробелами».Если есть, расширьте диапазон до тех пор, пока эти символы не будут обнаружены, и удалите.Это оставит форматирование без изменений.(Поскольку это не меняет весь абзац, работает «нормальный» цикл.)

Sub TestTrimParas()
    Dim p As Word.Paragraph
    Dim i As Long
    Dim rng As Word.Range

    For Each p In ActiveDocument.Paragraphs
        Set rng = p.Range.Characters.First
        'Test for a space or TAB character
        If rng.Text = " " Or rng.Text = Chr(9) Then
            i = rng.MoveEndWhile(" " + Chr(9))
            Debug.Print i
            rng.Delete
        End If
    Next p
End Sub

Answer 2

Конечно, вы могли бы сделать это за небольшую часть времени без цикла, не используя ничего более хитрого, чем Find / Replace. Например:

Find = ^p^w
Replace = ^p

и

Find = ^w^p
Replace = ^p

В качестве макроса это становится:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertBefore vbCr
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = False
    .Text = "^p^w"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    .Text = "^w^p"
    .Execute Replace:=wdReplaceAll
  End With
  .Characters.First.Text = vbNullString
End With
Application.ScreenUpdating = True
End Sub

Обратите внимание, что усечение текста, как вы это делаете, может уничтожить все форматирование внутри параграфа, поля перекрестных ссылок и т. П .; это также не изменит отступов . Отступы можно удалить, выбрав весь документ и изменив формат абзаца; еще лучше, измените базовые стили (при условии, что они были использованы правильно).

Answer 3

Как сказала @Cindy Meister, мне нужно предотвратить бесконечное создание других абзацев, обрезая их. Я имею в виду, что диапазон абзаца содержит по крайней мере 1 символ, поэтому диапазон обработки - 1 символ будет безопасным. Следующее сработало для меня

Sub ProcessParagraphs()
    Set docContent = ActiveDocument.Content

    ' replace TAB symbols throughout the document to single space (trim does not remove TAB)
    docContent.Find.Execute FindText:=vbTab, ReplaceWith:=" ", Replace:=wdReplaceAll

    For Each p In ActiveDocument.Paragraphs

        ' delete empty paragraph (delete operation is safe, we cannot enter enternal loop here)
        If Len(p.range.Text) = 1 Then
            p.range.Delete

        ' remove whitespaces
        Else
            Set thisRg = p.range
            ' shrink range by 1 character
            thisRg.MoveEnd wdCharacter, -1
            thisRg.Text = Trim(thisRg.Text)
        End If

        p.LeftIndent = 0
        p.FirstLineIndent = 0
        p.Reset
        p.range.Font.Reset

    Next

    With Selection
        .ClearFormatting
    End With
End Sub

Answer 4

Ввод "вечного" цикла немного неприятен.Только Чак Норрис может выйти один.В любом случае, попробуйте выполнить проверку перед обрезкой, и она не будет введена:

Sub TestMe()

    Dim p As Paragraph
    For Each p In ThisDocument.Paragraphs
        If p.Range <> Trim(p.Range) Then p.Range = Trim(p.Range)
    Next p

End Sub