Макрос для смены стиля надстрочных

[DJTreeno]

Помогите плиз не получается сменить стиль, хотя вручную делает и не выходит из цикла(((

Sub Superscript()
Dim oRange As Range
Set oRange = ActiveDocument.Range
With oRange.Find
.ClearFormatting
.Forward = True
.Format = True
.Wrap = wdFindStop
.Font.Superscript = True
.Execute
While .Found

oRange.Select
Selection.Font.Superscript = False
Selection.Style = ActiveDocument.Styles("Надстрочный" )

Wend
End With
End Sub

[viter.alex]

Зачем так усложнять? попробуйте мой вариант

With ActiveDocument.Range.Find
	.ClearFormatting
	.Text = ""
	.Format = True
	.Font.Superscript = True
	.Replacement.Text = ""
	.Replacement.Font.Superscript = False
	.Replacement.Style = ActiveDocument.Styles("Надстрочный")
	.Execute Replace:= wdReplaceAll
End With

[Скрипт]

viter.alex, "ClearFormatting" нет смысла делать, когда поиск ведётся с помощью "Range". При поиске с помощью "Range" создаётся новый экземпляр объекта "Find", в котором не будет никаких настроек, которые нужно сбрасывать.

[DJTreeno]

viter.alex, спасибо огромное заработало!!!