Word VBA Макросы: Word VBA Макросы: Прикрепить гиперссылку к тексту, у которого цветовое выделение (цвет выделения текста). Оформить гиперссылку как обычный текст.

[Anton]

Есть выделенные цветом (как в примере) фразы. Нужно только выделенную бирюзовым фразу превратить также в одноименную гиперссылку.
Ещё не хочется, чтобы гиперссылки были отформатированы синим с подчеркиванием, как быть?
Пусть будет, как обычный текст.

Помогите решить такую задачку!


[вложение удалено администратором]

[Администратор]

Макрос

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

[свернуть]

[Anton]

Огромное спасибо! Все работает!