Добрый день!
Нашел вот такой код
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
Так быстро! Выручили!
А то у меня есть подозрение, что при операциях замены эти гиперссылки мешают.
Большое спасибо!
Здравствуйте!
У меня встали встречаться ссылки, как в примере. Возникает при удалении ошибка. Помогите пожалуйста разобраться. Можно ли подправить макрос, чтобы удалял такие ссылки?
[вложение удалено администратором]
Какой-то очередной брак в ворде: что-то не так с гиперссылкой. Возможно проблемы возникают, когда данные копируются из других программ, а не создаются в самом ворде.
Макрос
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
Работает! Большое спасибо! Выручили!