Люди добрые помогите, в общем задача стоит в том что надо сделать макрос который по всему документы ищет стиль с "3 заголовком" и перед ним вставляет гиперсылку, у меня с кодингом проблемно, вот этот код (что смог накарякать) вроде ищет и вставляет но только в первом найденном, а мне надо чтоб он прошелся по всему тексту и в конце остановился...если кто может и поможет буду благодарен!


авторSub Search()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Заголовок 3")
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

If Selection.Find.Execute = True Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.Keyboard (1049)
Selection.TypeText Text:="Бла-бла-бла"
Selection.MoveLeft Unit:=wdCharacter, Count:=12, Extend:=wdExtend
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="Oglavlenie", ScreenTip:="", TextToDisplay:="Бла-бла-бла"
End If

End Sub

Народ сделал вот так:

Вот этот код ищет то что надо, вставляет, но на некоторых документах, просто ловит глюк и штопает в одно место их бесконечное множество раз, в чем причина ума не приложу, плиз хелп!

код
Sub Search()
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles(wdStyleHeading3)
Selection.Find.ParagraphFormat.Borders.Shadow = False
With Selection.Find
.ClearFormatting
.Style = wdStyleHeading3
Do Until Selection.Find.Execute = False
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.TypeBackspace
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Application.Keyboard (1049)
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:="Oglavlenie", ScreenTip:="", TextToDisplay:="Â ñîäåðæàíèå>>"
Selection.TypeParagraph
Selection.Find.Execute
Loop
End With
End Sub

Пробовал не помогло)))) мне нужен поиск по всему документу и не замена а добавление гиперлинка!