Word VBA: Как удалить все гиперссылки?

[Anton]

Добрый день!
Нашел вот такой код

Sub RemoveHyperlinks()
While ActiveDocument.Hyperlinks.Count > 0
ActiveDocument.Hyperlinks(1).Delete
Wend
Application.Options.AutoFormatAsYouTypeReplaceHyperlinks = False
End Sub

В основном документе гиперссылки удаляются, а вот в сносках и колонтитулах нет. Помогите пожалуйста дополнить код.

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

Макрос

Sub RemoveHyperlinks()

    Dim sec As Section, kolontitle As HeaderFooter


    '1. Отключение монитора (может это ускорит макрос и не будет мерцать).
    Application.ScreenUpdating = False
   
    '2. Удаление в основном тексте и сносках (страничных и концевых).
    Remove ActiveDocument.Range
    If ActiveDocument.Footnotes.Count <> 0 Then
        Remove ActiveDocument.StoryRanges(wdFootnotesStory)
    End If
    If ActiveDocument.Endnotes.Count <> 0 Then
        Remove ActiveDocument.StoryRanges(wdEndnotesStory)
    End If
   
    '3. Удаление в колонтитулах.
    For Each sec In ActiveDocument.Sections
        For Each kolontitle In sec.Headers
            Remove kolontitle.Range
        Next kolontitle
        For Each kolontitle In sec.Footers
            Remove kolontitle.Range
        Next kolontitle
    Next sec
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Private Sub Remove(rng As Range)
    Dim i As Long
    For i = rng.Hyperlinks.Count To 1 Step -1
        rng.Hyperlinks(i).Delete
    Next i
End Sub

[свернуть]

[Anton]

Так быстро! Выручили! 
А то у меня есть подозрение, что при операциях замены эти гиперссылки мешают.

Большое спасибо!

[Anton]

Здравствуйте!
У меня встали встречаться ссылки, как в примере. Возникает при удалении ошибка. Помогите пожалуйста разобраться. Можно ли подправить макрос, чтобы удалял такие ссылки?

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

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

Какой-то очередной брак в ворде: что-то не так с гиперссылкой. Возможно проблемы возникают, когда данные копируются из других программ, а не создаются в самом ворде.

Макрос

Sub RemoveHyperlinks()

    Dim sec As Section, kolontitle As HeaderFooter


    '1. Отключение монитора (может это ускорит макрос и не будет мерцать).
    Application.ScreenUpdating = False
   
    '2. Удаление в основном тексте и сносках (страничных и концевых).
    Remove ActiveDocument.Range
    If ActiveDocument.Footnotes.Count <> 0 Then
        Remove ActiveDocument.StoryRanges(wdFootnotesStory)
    End If
    If ActiveDocument.Endnotes.Count <> 0 Then
        Remove ActiveDocument.StoryRanges(wdEndnotesStory)
    End If
   
    '3. Удаление в колонтитулах.
    For Each sec In ActiveDocument.Sections
        For Each kolontitle In sec.Headers
            Remove kolontitle.Range
        Next kolontitle
        For Each kolontitle In sec.Footers
            Remove kolontitle.Range
        Next kolontitle
    Next sec
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Private Sub Remove(rng As Range)
    Dim i As Long
    For i = rng.Fields.Count To 1 Step -1
        If rng.Fields(i).Type = wdFieldHyperlink Then
            rng.Fields(i).Unlink
        End If
    Next i
End Sub

[свернуть]

[Anton]

Работает! Большое спасибо! Выручили!