Replace Styles Macro - Endless Loop

[CASabre]

Hi Everyone,

A couple of years ago, with much help from this group, I got a cool
macro that would go through a document and replace specific styles with
a different specific style. It worked great in Word 2000.

We have recently moved to Word 2003, and when I run the macro, it gets
stuck in an infinite loop if one of the styles specified in the "Find
Style" array does not exist in that particular document.

I'm sure it's a simple fix, but I'm not sure what I need to change.
It's been a couple of years since I've done any macro work, so I've
pretty much forgotten everything I learned.

Any help would be greatly appreciated!

---

Dim FindStyle As Variant, ReplaceStyle As Variant, k As Integer
FindStyle = Array("Style1", "Style2", "Style3", "Style4", "Style5")
ReplaceStyle = Array("Heading 2", "Heading 3", "Heading 4", "Heading
5", "Body Text1")
On Error Resume Next
With ActiveDocument.Range.Find
For k = LBound(FindStyle) To UBound(FindStyle)
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Format = True
.Style = FindStyle(k)
.Replacement.Style = ReplaceStyle(k)
Do While .Execute(Replace:=wdReplaceAll)
Loop
Next
End With
End Sub

 

[Russ]

You could test for the .inuse property. See VBA Help.

 

[CASabre]

Hmmm, I could, couldn't I?

See, I *knew* there was a simple solution. Thanks Russ!