Слишком большой для комментария (который должен быть, потому что это не хорошо проверено и может не делать то, что вы хотите).
Если Автоформат не делает достаточно (согласно нашему разговору в комментариях), я думаю, что вам нужно будет сделать изрядную сумму для каждой гиперссылки, т.е.
- убедитесь, что Word распознал ее как гиперссылку (в этом случае вы должны увидеть код поля {HYPERLINK}, если используете Alt-F9)
- применить стиль символа гиперссылки к результату поля HYPERLINK
- повторно примените форматирование символов к результату поля HYPERLINK, чтобы исправить ущерб, который может нанести стиль гиперссылки
Если импортированный текст содержит несколько гиперссылок, выполнение всего этого, вероятно, будет довольно утомительным, поэтому следующий фрагмент VBA предназначен для исправления гиперссылок в теле текущего активного документа Word.
Он будет обнаруживать только то, что Word считает гиперссылками (не обязательно все, что вы ожидаете).
Я бы посоветовал вам, если возможно, сначала открыть любые импортированные тексты как отдельные документы, а затем запустить этот код. Это должно минимизировать нежелательные побочные эффекты.
Особенность стиля символа Гиперссылка заключается в том, что он применяет "Шрифт абзаца по умолчанию", который может не иметь таких свойств (например, размер и т.д.), Как у существующего текста. Даже если вы измените стиль, чтобы использовать "Базовые свойства", он может изменить размер текста и так далее. Итак, что я сделал здесь, так это посмотрел на свойства первого символа в "отображаемом тексте" для гиперссылки и повторно применил его ко всему отображаемому тексту после применения стиля гиперссылки.
Но если вы применяете свои собственные стили абзаца к импортированному тексту, более вероятно, что текст, стилизованный с помощью стиля гиперссылки, все равно будет делать то, что вы хотите, так что вы можете удалить этот бит VBA.
Если вам нужно искать гиперссылки в других "историях" в документе, таких как текстовые поля, верхние и нижние колонтитулы и т.д., Вам определенно понадобится больше.
Private Type AutoFormatOptions
bAutoFormatApplyBulletedLists As Boolean
bAutoFormatApplyFirstIndents As Boolean
bAutoFormatApplyHeadings As Boolean
bAutoFormatApplyLists As Boolean
bAutoFormatApplyOtherParas As Boolean
bAutoFormatDeleteAutoSpaces As Boolean
bAutoFormatMatchParentheses As Boolean
bAutoFormatPlainTextWordMail As Boolean
bAutoFormatPreserveStyles As Boolean
bAutoFormatReplaceFarEastDashes As Boolean
bAutoFormatReplaceFractions As Boolean
bAutoFormatReplaceHyperlinks As Boolean
bAutoFormatReplaceOrdinals As Boolean
bAutoFormatReplacePlainTextEmphasis As Boolean
bAutoFormatReplaceQuotes As Boolean
bAutoFormatReplaceSymbols As Boolean
End Type
Sub fixUpHyperlinks()
Dim afo As AutoFormatOptions
Dim f As Word.Font
Dim h As Word.Hyperlink
' Save existing autoformat options
With Application.Options
afo.bAutoFormatApplyBulletedLists = .AutoFormatApplyBulletedLists
afo.bAutoFormatApplyFirstIndents = .AutoFormatApplyFirstIndents
afo.bAutoFormatApplyHeadings = .AutoFormatApplyHeadings
afo.bAutoFormatApplyLists = .AutoFormatApplyLists
afo.bAutoFormatApplyOtherParas = .AutoFormatApplyOtherParas
afo.bAutoFormatDeleteAutoSpaces = .AutoFormatDeleteAutoSpaces
afo.bAutoFormatMatchParentheses = .AutoFormatMatchParentheses
afo.bAutoFormatPlainTextWordMail = .AutoFormatPlainTextWordMail
afo.bAutoFormatPreserveStyles = .AutoFormatPreserveStyles
afo.bAutoFormatReplaceFarEastDashes = .AutoFormatReplaceFarEastDashes
afo.bAutoFormatReplaceFractions = .AutoFormatReplaceFractions
afo.bAutoFormatReplaceHyperlinks = .AutoFormatReplaceHyperlinks
afo.bAutoFormatReplaceOrdinals = .AutoFormatReplaceOrdinals
afo.bAutoFormatReplacePlainTextEmphasis = .AutoFormatReplacePlainTextEmphasis
afo.bAutoFormatReplaceQuotes = .AutoFormatReplaceQuotes
afo.bAutoFormatReplaceSymbols = .AutoFormatReplaceSymbols
End With
On Error GoTo cleanup
' set everything the way we want
With Application.Options
' all false
.AutoFormatApplyBulletedLists = False
.AutoFormatApplyFirstIndents = False
.AutoFormatApplyHeadings = False
.AutoFormatApplyLists = False
.AutoFormatApplyOtherParas = False
.AutoFormatDeleteAutoSpaces = False
.AutoFormatMatchParentheses = False
.AutoFormatPlainTextWordMail = False
.AutoFormatPreserveStyles = False
.AutoFormatReplaceFarEastDashes = False
.AutoFormatReplaceFractions = False
' except this one
.AutoFormatReplaceHyperlinks = True
.AutoFormatReplaceOrdinals = False
.AutoFormatReplacePlainTextEmphasis = False
.AutoFormatReplaceQuotes = False
.AutoFormatReplaceSymbols = False
End With
With ActiveDocument
' Apply the selected formats
.Kind = wdDocumentNotSpecified
.Content.AutoFormat
' Now apply the Hyperlink style to all Hyperlink field result ranges
For Each h In .Hyperlinks
With .Range.Fields(1).Result
If .Characters.Count >= 1 Then
' Remove the following line if the Hyperlink style works for you
Set f = .Characters(1).Font.Duplicate
' Apply the Hyperlink style
.Style = ActiveDocument.Styles(wdStyleHyperlink).NameLocal
' Remove the following 2 lines if the Hyperlink style works for you
Set .Font = f
set f = Nothing
End If
End With
Next
End With
cleanup:
' restore the original settings
With Application.Options
.AutoFormatApplyBulletedLists = afo.bAutoFormatApplyBulletedLists
.AutoFormatApplyFirstIndents = afo.bAutoFormatApplyFirstIndents
.AutoFormatApplyHeadings = afo.bAutoFormatApplyHeadings
.AutoFormatApplyLists = afo.bAutoFormatApplyLists
.AutoFormatApplyOtherParas = afo.bAutoFormatApplyOtherParas
.AutoFormatDeleteAutoSpaces = afo.bAutoFormatDeleteAutoSpaces
.AutoFormatMatchParentheses = afo.bAutoFormatMatchParentheses
.AutoFormatPlainTextWordMail = afo.bAutoFormatPlainTextWordMail
.AutoFormatPreserveStyles = afo.bAutoFormatPreserveStyles
.AutoFormatReplaceFarEastDashes = afo.bAutoFormatReplaceFarEastDashes
.AutoFormatReplaceFractions = afo.bAutoFormatReplaceFractions
.AutoFormatReplaceHyperlinks = afo.bAutoFormatReplaceHyperlinks
.AutoFormatReplaceOrdinals = afo.bAutoFormatReplaceOrdinals
.AutoFormatReplacePlainTextEmphasis = afo.bAutoFormatReplacePlainTextEmphasis
.AutoFormatReplaceQuotes = afo.bAutoFormatReplaceQuotes
.AutoFormatReplaceSymbols = afo.bAutoFormatReplaceSymbols
End With
' Application.Options.AutoFormatApplyBulletedLists
' Selection.Document.Kind = wdDocumentNotSpecified
' Selection.Range.AutoFormat
End Sub
