Макрос для Word'a

Сабж, может пригодиться райтерам или сео-шникам. В комментах все описано. Собственно, изготовлено из пары записанных макросов, но дабы в следующий раз не думать над wildcards...
Написано грубо, работает в три прохода, подозреваю, что многие опции можно поубирать - но получилось "навскидку" и особо пока не заморачивался - нет такой цели.

Существенный минус - распознает ключи, состоящие только из пары слов или одного. Три, четыре не воспринимает. Решение "с ходу" не придумалось.

Sub tags_b()
'
' Обрамляем плотный (bold) текст документа тегами <b> и </b>
' by ssept8 :)

'
' ищем ключики, состоящие из нескольких слов и меняем пробелы между ними на три "ъ"
' делается, дабы избежать разбиения составных ключей на множество состоящих из единственного слова
' надо помнить, что "ъъъ", если случайно будет находиться в оригинале текста, будет впоследствии вырезан беспощадным пробелом.
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<[A-Za-zА-яЁё]@*)^0032(<[A-Za-zА-яЁё]@*)"
'        .Replacement.Text = "\1^s\2"
        .Replacement.Text = "\1ъъъ\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   ищем выделенный болдом текст, заканчивающийся "концом слова" (знак > в подстановочной маске поиска)
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<[A-Za-zА-яЁё]@*)>"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   последний этап, вернем пробелы на свои места - меняем наши "ъъъ" на пробелы во всем тексте
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "ъъъ"
        .Replacement.Text = "^0032"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub