Сабж, может пригодиться райтерам или сео-шникам. В комментах все описано. Собственно, изготовлено из пары записанных макросов, но дабы в следующий раз не думать над 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
