Microsoft Office Forums - View Single Post - Never-ending loop

Guessed · 06-13-2022, 08:48 PM

As I don't have a sample document to test on, I can't guarantee this would work but conceptually, this code will find graphics from the current selection forward and if the found graphic is marked as a tracked revision it rejects the change and searches for the next graphic.

Code:

Sub Huh()
  Dim aRng As Range
  
  Set aRng = Selection.Range
  aRng.End = ActiveDocument.Range.End
  With aRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^g"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    Do While .Execute = True
      If aRng.Revisions.Count > 0 Then
        aRng.Revisions.RejectAll
      End If
      aRng.Collapse Direction:=wdCollapseEnd
      aRng.End = ActiveDocument.Range.End
    Loop
  End With
End Sub