Есть выделенные цветом (как в примере) фразы. Нужно только выделенную бирюзовым фразу превратить также в одноименную гиперссылку.
Ещё не хочется, чтобы гиперссылки были отформатированы синим с подчеркиванием, как быть?
Пусть будет, как обычный текст.
Помогите решить такую задачку!
[вложение удалено администратором]
Макрос
Sub Макрос()
Dim find_rng As Range, find As find
Dim rng As Range
' Отключение монитора (может это ускорит макрос).
Application.ScreenUpdating = True
'1. Настройка стилей, чтобы гиперссылки были в виде обычного текста.
With ActiveDocument.Styles("Гиперссылка").Font
.Underline = wdUnderlineNone
.Color = wdColorAutomatic
End With
With ActiveDocument.Styles("Просмотренная гиперссылка").Font
.Underline = wdUnderlineNone
.Color = wdColorAutomatic
End With
'2. Создание объектов для поиска.
Set find_rng = ActiveDocument.Range(ActiveDocument.Range.End - 1, ActiveDocument.Range.End - 1)
Set find = find_rng.find
'3. Настройка поиска.
find.Highlight = True
' Двигаемся от конца файла в начало, т.к. найденный фрагмент будет изменяться,
' и тяжело предсказать, что с ним произойдёт.
find.Forward = False
find.Wrap = wdFindStop
'4. Поиск и замена.
Do While find.Execute = True
' Смотрим, какое цветовое выделение.
' Если найдено, то find_rng - это найденный фрагмент.
If find_rng.HighlightColorIndex = wdTurquoise Then
' Присваиваем имя найденному фрагменту, т.к. объект "find_rng" будет изменён и
' мы потеряем доступ к найденному фрагменту.
Set rng = find_rng.Duplicate
' Смещение невидимого курсора влево от найденного фрагмента, чтобы поиск
' начался от найденного фрагмента и до начала файла.
find_rng.Collapse Direction:=wdCollapseStart
' Вставка гиперссылки.
ActiveDocument.Hyperlinks.Add Anchor:=rng, Address:=rng.Text, SubAddress:="", _
ScreenTip:="", TextToDisplay:=rng.Text
End If
Loop
' Вкл. монитора.
Application.ScreenUpdating = True
'5. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Огромное спасибо! Все работает!