Замена текста в StoryRange в Word VBA делает его кратковременно не отвечающим

Question

Я использовал следующий код для поиска и замены текста в каждом сюжете, хотя я специально искал нижние колонтитулы / верхние колонтитулы и основной текст.

For Each myStoryRange In ActiveDocument.StoryRanges
    If myStoryRange.StoryType = wdPrimaryFooterStory Then

        myStoryRange.Find.Execute FindText:=footerfindreplace.Item(i).FND, Forward:=True, ReplaceWith:=footerfindreplace.Item(i).replc, Wrap:=wdFindContinue, replace:=wdReplaceAll

    End If
    If myStoryRange.StoryType = wdFirstPageFooterStory Then
        myStoryRange.Find.Execute FindText:=footerfindreplace.Item(i).FND, Forward:=True, ReplaceWith:=footerfindreplace.Item(i).replc, Wrap:=wdFindContinue, replace:=wdReplaceAll
    End If

    If myStoryRange.StoryType = wdEvenPagesFooterStory Then
        myStoryRange.Find.Execute FindText:=footerfindreplace.Item(i).FND, Forward:=True, ReplaceWith:=footerfindreplace.Item(i).replc, Wrap:=wdFindContinue, replace:=wdReplaceAll

    End If

Next myStoryRange

Для нижних колонтитулов все работало нормально, и если в документе был только один раздел. Однако у меня есть документы с более чем одним разделом, и я бы предпочел просмотреть все документы. Поэтому я нашел другой подход:

With ActiveDocument
  For Each Rng In .StoryRanges
    On Error Resume Next
    With Rng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindContinue
      .Text = footerfindreplace.Item(i).FND
      .Replacement.Text = footerfindreplace.Item(i).replc
      .MatchCase = True
      .Execute replace:=wdReplaceAll
    End With
    On Error GoTo 0
  Next
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          With .Range.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Format = False
            .Forward = True
            .Wrap = wdFindContinue
            .Text = footerfindreplace.Item(i).FND
            .Replacement.Text = footerfindreplace.Item(i).replc
            .Execute replace:=wdReplaceAll
          End With
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
          With .Range.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Format = False
            .Forward = True
            .Wrap = wdFindContinue
            .Text = footerfindreplace.Item(i).FND
            .Replacement.Text = footerfindreplace.Item(i).replc
            .Execute replace:=wdReplaceAll
          End With
        End If
      End With
    Next
  Next
    End With

Это работает отлично, но есть кое-что, что мне не нравится, слово перестает отвечать на запросы примерно на 10 секунд, независимо от документа. Я также обнаружил, что существует 17 типов сюжетов, и, возможно, именно поэтому это занимает так много времени.

Я знаю, по крайней мере, что с верхними и нижними колонтитулами (которых их 6) я могу использовать условие .Exists = true или false, чтобы пропустить их. Но это не сильно улучшает результат.

У меня есть только 5 слов для замены. Почему он перестает отвечать? Есть ли способ сделать это гладко?

Спасибо за любую помощь.

Обновление:

Прочитав комментарии, я попробовал следующее безрезультатно

With ActiveDocument.StoryRanges(1).Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindContinue
      .Text = footerfindreplace.Item(i).FND
      .Replacement.Text = footerfindreplace.Item(i).replc
      .MatchCase = True
      .MatchAllWordForms = False
      .MatchWholeWord = False
      .MatchWildcards = False
      End With

  For Each Rng In ActiveDocument.StoryRanges
    On Error Resume Next
    With Rng.Find
    .Text = footerfindreplace.Item(i).FND
      .Replacement.Text = footerfindreplace.Item(i).replc
      .Execute replace:=wdReplaceAll
    End With
    On Error GoTo 0
  Next
  For Each Sctn In ActiveDocument.Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
        If HdFt.Exists = True Then
          With .Range.Find
          .Text = footerfindreplace.Item(i).FND
      .Replacement.Text = footerfindreplace.Item(i).replc
            .Execute replace:=wdReplaceAll
          End With
          End If
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
        If HdFt.Exists = True Then
          With .Range.Find
          .Text = footerfindreplace.Item(i).FND
      .Replacement.Text = footerfindreplace.Item(i).replc
            .Execute replace:=wdReplaceAll
          End With
          End If
        End If
      End With
    Next
  Next

Если я не поставлю

  .Text = footerfindreplace.Item(i).FND
  .Replacement.Text = footerfindreplace.Item(i).replc

В каждом цикле он не будет заменен. Также отображение обновления уже ложно. Кто-нибудь может помочь?

Обновление: Недавно я попытался найти каждый раздел в пределах диапазона истории, надеясь отфильтровать порядок.

For Each storyrang In ActiveDocument.StoryRanges
For Each Sctn In storyrang.Sections
For Each rang In Sctn.Ranges
With rang
For ii = 1 To footerfindreplace.count
  Call RngFnd(.Range, footerfindreplace.Item(i).FND, footerfindreplace.Item(i).replc) 'find and replace text in the given range
  Next ii
  End With
  Next
  Next
  Next

Результат, однако, остается не очень хорошим

Answer 1

В вашем коде отсутствует контекст, особенно в отношении footerfindreplace.Item (i) .FND и footerfindreplace.Item (i) .replc. Ваш код также обрабатывает все сюжетные линии (включая верхние и нижние колонтитулы), а затем снова обрабатывает верхние и нижние колонтитулы в разделе.

Если footerfindreplace.Item (i) .FND и footerfindreplace.Item (i) .replc представляют один вызов документа, вы можете использовать код, подобный следующему:

Sub Demo()
Application.ScreenUpdating = False
Dim Sctn  As Section, HdFt As HeaderFooter
With ActiveDocument
  Call RngFnd(.Range, footerfindreplace.Item(i).FND, footerfindreplace.Item(i).replc)
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          Call RngFnd(.Range, footerfindreplace.Item(i).FND, footerfindreplace.Item(i).replc)
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
          Call RngFnd(.Range, footerfindreplace(i).FND, footerfindreplace(i).replc)
        End If
      End With
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub RngFnd(Rng As Range, StrFnd As String, StrRep As String)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .Wrap = wdFindContinue
  .Text = StrFnd
  .Replacement.Text = StrRep
  .MatchCase = True
  .Execute Replace:=wdReplaceAll
End With
End Sub

В качестве альтернативы, если вы обрабатываете несколько элементов footerfindreplace, вы можете использовать такой код:

Sub Demo()
Application.ScreenUpdating = False
Dim Sctn  As Section, HdFt As HeaderFooter
With ActiveDocument
  Call RngFnd(.Range, footerfindreplace)
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          Call RngFnd(.Range, footerfindreplace)
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
          Call RngFnd(.Range, footerfindreplace)
        End If
      End With
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub RngFnd(Rng As Range, ArrFndRep)
Dim i As Long
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .MatchCase = True
  .Wrap = wdFindContinue
  For i = 0 To UBound(ArrFndRep)
    .Text = ArrFndRep(i).FND
    .Replacement.Text = ArrFndRep(i).replc
  .Execute Replace:=wdReplaceAll
  Next
End With
End Sub

В любом случае, едва ли понятно, почему вы обрабатываете что-то, описанное как footerfindreplace, либо в теле документа, либо в его заголовках ...