I've tried some of the find & replace macros mentioned at various times in the discussion groups and they do seem to be rather unreliable with certain complicated documents. This one, which I copied from a link, seemed to one of the most straightforward and runs on most documents but sometimes ends up in an endless loop in certain cases with text boxes inside what I think is a frame (hatched box which you can't seem to resize). Any idea what can be going wrong or how I can diagnosis the problem? Sub FasterResetSpacing() Application.ScreenUpdating = False Dim spacingStoryRange As Range 'First search the main document using the Selection With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "^?" .Replacement.Text = "^&" .Forward = True .Format = True .Replacement.Font.Spacing = 0 .Replacement.Font.Scaling = 100 .Replacement.Font.Position = 0 .Replacement.Font.Kerning = 0 .Wrap = wdFindContinue .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With 'Now search all other stories using Ranges For Each spacingStoryRange In ActiveDocument.StoryRanges If spacingStoryRange.StoryType <> wdMainTextStory Then With spacingStoryRange.Find .Text = "^?" .Replacement.Text = "^&" .Format = True .Replacement.Font.Spacing = 0 .Replacement.Font.Scaling = 100 .Replacement.Font.Position = 0 .Replacement.Font.Kerning = 0 .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With Do While Not (spacingStoryRange.NextStoryRange Is Nothing) Set spacingStoryRange = spacingStoryRange.NextStoryRange With spacingStoryRange.Find .Text = "^?" .Replacement.Text = "^&" .Format = True .Replacement.Font.Spacing = 0 .Replacement.Font.Scaling = 100 .Replacement.Font.Position = 0 .Replacement.Font.Kerning = 0 .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With Loop End If Next spacingStoryRange End Sub Any help much appreciated. David Turner
After consulting the archives, it sounds like I have a similar problem to the Find/Replace bug reported by Jean-Guy-Marcil in July. When I isolate one of the offending frame shapes containing text boxes and run the macro on it, it goes into an infinite loop searching from one text box to another. Did anyone come up with a solution? David Turner "I have a document that has Figures made up of many textboxes connected by lines. They were created by converting embeded Visio drawings into enhanced meta files, and then edited by right clicking on them. The Figures were cleaned up so that they consit only of lines and textboxes containing textframes. All useless shapes that the Edit command created have been removed. (This complicated process was used because it would have been too long to recreate the complex Figures from scratch within Word. It was overall faster to convert these complex English Figures into editable ones so that people who do not have Visio installed can easily translate them.) Those figures are held within a 1x1 table. Here is the bug: All highlighted text in the main story is picked up. Many of the shapes within the figures have highlighted text in them. Only about 5% of the highlighted text is being picked up by the function. I debugged the code and I know that the second ""With rgeFind.Find" above is being executed, but the corresponding "Do While .Execute" fails, as if the range from the textframes did not contained highlighted text when in fact it does..."
As Tony Jollans pointed out, collapsing the range just before starting the find seems to do the trick. Maybe the various find and replace anywhere macros need to include this to allow them to correctly search in textframes of this type? Do While Not (spacingStoryRange.NextStoryRange Is Nothing) Set spacingStoryRange = spacingStoryRange.NextStoryRange spacingStoryRange.Collapse wdCollapseEnd With spacingStoryRange.Find .Text = "^?" .Replacement.Text = "^&" .Format = True .Replacement.Font.Spacing = 0 .Replacement.Font.Scaling = 100 .Replacement.Font.Position = 0 .Replacement.Font.Kerning = 0 .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With Loop David Turner
