Visual Basic for Office
У нас есть подразделение - газета.
Мы скидываем им перед каждым выпуском объявления в номер типа:
Код:
* "Ауди-80" (переходная), 85 г.в., 1.6Б
тел. 6-02-57, после 17.00
* "Ауди-80", 88 г.в., 1.8К, 2800 у.е.
тел. 8 (029) 353-16-98, после 18.00
* "Ауди-100", 83 г.в., 1.9К, с 19:00 до 22:00
тел. 8 (029) 643-44-04
* "Ауди-100", 83 г.в., 2.0
обр. по адресу: ул. Наумова, 21/15
Нужно сделать так, чтобы по средством вордового скрипта вся строчка тел. стала жирной.
Пытался написать скрипт:
Код:
Sub tel()
'
' Time Макрос
' Макрос записан 04.04.06 **
'
Set myRange = ActiveDocument.Content
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
.Text = "тел. [0-9]-[0-9][0-9]-[0-9][0-9]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
.Text = ", [0-9]-[0-9][0-9]-[0-9][0-9]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
.Text = "тел. 8 (029) [0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
.Text = ", 8 (029) [0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
.Text = ", после [0-9][0-9].[0-9][0-9]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
.Text = ", с [0-9][0-9].[0-9][0-9] до [0-9][0-9].[0-9][0-9]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
End With
myRange.Find.Execute Replace:=wdReplaceAll
End Sub
НЕ РАБОТАЕТ СВОЛОЧЬ!!! Телефоны вида *-**-** красит, а 8 (029) ***-**-** игнорирует. Ни ошибок, ничего. Просто не красит. Где ошибка? |
