Как найти экземпляры текста с определенным стилем, примененным в Word 2010
Цель состоит в том, чтобы создать список текстовых элементов в документе Word 2010, идентифицируемых с помощью применения определенного стиля. Этот список затем отправляется куда-то еще, чтобы сделать захватывающие вещи.
Контекст: этот стиль применяется вручную, когда авторы создают свои документы. Помимо надлежащего форматирования текста, он идентифицирует текст, который впоследствии должен быть извлечен в другой итоговый документ. В настоящее время это лист Excel, но, в зависимости от требований, он также может быть другим документом Word.
Я с интересом отмечаю этот вопрос и его ответ: найдите абзацы по стилю в слове 2010 с помощью взаимодействия
Я (думаю, мне) нужно сделать это в VBA, а не в C#, однако, поскольку я хотел бы добавить его в шаблон по умолчанию для Normal.dotm, для удобства распространения в моей команде.
Я думаю, что вопрос, который я действительно задаю, это "какой самый эффективный способ пройтись по документу и проверить стиль, применяемый к каждому слову, выполняя действие над этим словом, если это необходимо?"
Целевые документы могут быть довольно большими - >400 страниц - и поэтому эффективность может быть проблемой.
Вещи, которые я не могу сделать по деловым причинам:
- Изменить на другой продукт или формат для соответствующих документов
- Перейдите на более новую версию Word
- Используйте язык или инструмент, который не поставляется по умолчанию с Word
2 ответа
Вы можете использовать.Find
метод и укажите стиль с помощью.Style
. Пример:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Style = "Heading 1" 'Replace this with name of your style
While .Execute
ActiveDocument.Range.InsertAfter vbCr & oRng
ActiveDocument.Paragraphs.Last.Range.Style = "Normal"
oRng.Collapse wdCollapseEnd
Wend
End With
End Sub
Источник: https://www.msofficeforums.com/word-vba/23001-creating-list-all-text-specific-style.html .
Кажется, блокируется бесконечный цикл при сканировании всех стилей.
Работая с другим подходом для выбора всех стилей, добавьте к выделенному элементу применение стиля, однако стили символов и стили абзацев нарушают форматирование... Думаю, я нашел обходной путь... может быть, это излишне?
Sub STYLE_reset_overrides_to_style()
''override independent text overrides with style formatting.
''Selection.ClearCharacterStyle unfortunately ALSO clears character styles along with independent formatting.
''Maybe look for all non-paragraph styles to add to selection adn apply char styles?
' https://www.msofficeforums.com/word-vba/47165-macro-select-headings-all-styles.html
'Adapted to select ranges and pleace styles.
Dim oParas As Paragraph ''selected paragraphs
Dim oChar As Characters ''selection characters???<-----break and debug if char styles need to eb separate...
Dim oStyle As Style ''styles to find/replace
'Application.ScreenUpdating = False
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
''For my case- we want to clear all direct formatting and rely 100% on styles...
''Could search for special formatting and create styles before clearing as well...
Selection.WholeStory ''Select everything
Selection.ClearCharacterDirectFormatting ''clear direct formatting. Styles intact.
For Each oStyle In ActiveDocument.Styles ''Cycle through styles to match....
If oStyle.InUse And oStyle.Description Like "*indent:*" Then
For Each oParas In ActiveDocument.Paragraphs
If oParas.Style = oStyle Then ''If styles match then add to collection
oParas.Range.Editors.Add wdEditorEveryone ''add to editable collection
End If
Next
ActiveDocument.SelectAllEditableRanges wdEditorEveryone ''Select all applicable paragraphs
If Not Selection Is Nothing Then ''if there is something selected...
''Find Replace active selection of selected - quick way to apply corresponding styles
Selection.Find.ClearFormatting
Selection.Find.Style = oStyle
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = oStyle
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue ''Replace everything everywhere
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll 'Execute find/replace styles
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone ''delete selection collection
End If
End If
Next oStyle
'Application.ScreenUpdating = True
End Sub