Статьи из блога

Поиск и применение стилей к абзацам документа

Вопрос от Андрея:

Между "@" и "" в начале абзацев (не всех) расставлены стили, которые необходимо применить к абзацам, а саму отметку стереть. Вот, например: @MIH_HEAD_F АУДИТОРСКОЕ ЗАКЛЮЧЕНИЕ. После работы макроса получаем:"АУДИТОРСКОЕ ЗАКЛЮЧЕНИЕ" стилем MIH_HEAD_F. При этом в тексте могут встречаться и простые @ (например e-mail) без знака. Все возможные стили уже в ворде.

Я предложил следующий пример макроса:

Sub styleApply_Delete()
'Ищем вхождение строки типа "@MIH_HEAD_F ",
'применяем к текущему параграфу стиль, имя которого взято из найденного вхождения,
'удаляем найденное вхождение строки,
'удаляем лишние пробелы перед абзацами
Dim myStyle As String
Dim par As Paragraph
On Error Resume Next
With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = "(\@)([A-z]{1;}^32)"
   .Forward = True
   .MatchWildcards = True
   .Wrap = wdFindContinue
   Do While .Execute
      With Selection
         If Right(.Range, 1) = Chr(32) Then
            .MoveLeft unit:=wdCharacter, count:=1, Extend:=wdExtend
         End If
         .MoveStart unit:=wdCharacter, count:=1 'сужаем выделение слева
         myStyle = Selection.Text   'запоминаем выделение
         .MoveStart unit:=wdCharacter, count:=-1   'расширяем выделение слева
         .Paragraphs(1).Style = myStyle   'применяем к текущему параграфу стиль с именем выделения
         .Delete  'удаляем выделение
      End With
   Loop
End With
'Удаляем лишние пробелы перед параграфами (абзацами)
For Each par In ActiveDocument.Paragraphs
   If Left(par.Range.Text, 1) = Chr(32) Then
      par.Range.Text = LTrim(par.Range.Text)
   End If
Next par
End Sub

Чуть позже Андрей сообщил:

Благодарю за участие!
Макрос рабочий.
Если интересно, привожу способ, на котором остановились. Маска поиска тэгов оказалась неработоспособной, так как в некоторых текстах встречались адреса электронной почты, которые приводили к некорректной работе.
Поскольку тэгов было порядка 15 штук - для каждого был создан подобный фрагмент кода:
' Обрабатываем каждый тэг стиля и применяем к соответствующему абзацу
  With ActiveDocument.range.find
    .Text = "\@EMPTY_LS = ": .MatchWildcards = True
    While .Execute
      'Определяем имя стиля из найденного текста, убирая @, = и обрезая пробелы
      sStyleName = Trim(Replace(Replace(.Parent.Text, "@", ""), "=", ""))
      'Применяем стиль к абзацу, в котором найден текст
      .Parent.Paragraphs(1).range.ParagraphFormat.Style = ActiveDocument.Styles(sStyleName)
      'Обработчик ошибки, на тот случай, если стиль в документе отсутствует. Если ошибки нет,
      'то найденный текст удаляем.
      If Err.Number = 5941 Then Err.Clear Else: .Parent.Delete
    Wend
  End With
twitter.com facebook.com vkontakte.ru odnoklassniki.ru mail.ru ya.ru rutvit.ru myspace.com technorati.com digg.com friendfeed.com pikabu.ru blogger.com liveinternet.ru livejournal.ru memori.ru google.com bobrdobr.ru mister-wong.ru yahoo.com yandex.ru del.icio.us

Еще записи по вопросам использования Microsoft Word:

Комментариев: 2

  1. Igor
    12.09.2009 в 00:04 | #1

    БОльшое спасибо за очень нужный сайт! Я много работаю с текстом и мне Ваш сайт очень помогает.

    У меня возникла такая проблема.

    С какого-то момента текстовые страницы, с которыми я работаю ни с того ни с сего вдруг стали открываться с различными hiperlink вместо нормальных цифр, например, номеров страниц. Я понимаю, что это показываются какие-то ВЕБ-компоненты. Но я с ВЕБ и с интернетом в текстовом редакторе не работаю и откуда все это мне не понятно. Причем, никак не могу вернуть нормальный вид.

    Помогите пожалуйста советом!

  2. 12.09.2009 в 07:23 | #2

    Игорь, посмотрите вот эту заметку: http://wordexpert.ru/page/kodyi-poley-vmesto-ssyilok-kak-vosstanovit-vid-ssyilok

Оставьте комментарий!

(обязательно)

^ Наверх