Проблема такая - нужно найти в сносках слово google и удалить у этих слов гиперссылку. Остальные слова с гиперссылками не менять.
Я записала макрос найти и заменить, но он только находит нужные мне слова. А как проверить, есть ли у этих слов гиперссылка и удалить ее?
[вложение удалено администратором]
В вашем файле-примере гиперссылки особые - после удаления гиперссылки, оформление остаётся: синий цвет, подчёркивание. Я создал в вашем файле гиперссылку и после макроса оформление не осталось. Я не стал ничего делать для такой ситуации.
В самом верху модуля вставьте 'Option Compare Text' (без кавычек), чтобы поиск вёлся без учёта регистра букв (больших / маленьких букв).
Поместите обе процедуры в один модуль. Запускайте процедуру 'Макрос'.
Макрос
Sub Макрос()
' Отключение монитора (может это ускорит макрос).
Application.ScreenUpdating = False
'1. Удаление гиперссылок в страничных сносках.
If ActiveDocument.Footnotes.Count <> 0 Then
DelHyperlinks ActiveDocument.StoryRanges(wdFootnotesStory)
End If
'2. Удаление гиперссылок в концевых сносках.
If ActiveDocument.Endnotes.Count <> 0 Then
DelHyperlinks ActiveDocument.StoryRanges(wdEndnotesStory)
End If
' Включение монитора.
Application.ScreenUpdating = True
'3. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Private Sub DelHyperlinks(rng As Range)
Dim hyp As Hyperlink, i As Long
' Движение по всем гиперссылкам, которые есть в сносках, от последней к первой.
For i = rng.Hyperlinks.Count To 1 Step -1
' Присваиваем гиперссылке имя 'hyp'. Далее в коде будем обращатья к гиперссылке по имени 'hyp',
' это должно упростить чтение и написание макроса.
Set hyp = rng.Hyperlinks(i)
' Если в гиперссылке есть слово 'google'.
If InStr(hyp.TextToDisplay, "google") <> 0 Then
' Удаление гиперссылки. Удаляется только гиперссылка, а текст остаётся.
hyp.Delete
End If
Next i
End Sub
Большое спасибо! Попробую.
А можно вместо слова "google" использовать подстановочные знаки, например искать слово из английских букв <[A-z]@>?
Поиск с использованием 'Найти и заменить'.
В этом случае параметр 'Option Compare Text' не имеет значения.
Макрос
Sub Макрос()
' Отключение монитора (может это ускорит макрос).
Application.ScreenUpdating = False
'1. Удаление гиперссылок в страничных сносках.
If ActiveDocument.Footnotes.Count <> 0 Then
DelHyperlinks ActiveDocument.StoryRanges(wdFootnotesStory)
End If
'2. Удаление гиперссылок в концевых сносках.
If ActiveDocument.Endnotes.Count <> 0 Then
DelHyperlinks ActiveDocument.StoryRanges(wdEndnotesStory)
End If
' Включение монитора.
Application.ScreenUpdating = True
'3. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Sub DelHyperlinks(rng As Range)
Dim find_rng As Range, find As find
Dim i As Long
'1. Создание объектов, которые будут искать.
' Присваиваем диапазону, в котором находятся сноски, имя find_rng.
Set find_rng = rng.Duplicate
' Превращаем фрагмент в точку вставки. Действие аналогично этому:
'1) юзер выделяет фрагмент;
'2) затем юзер нажимает клавишу-стрелку влево.
' Если фрагмент будет в виде точки вставки, то поиск будет не в выделенном фрагменте, а
' по всей области, в данном случае по области сносок.
find_rng.Collapse Direction:=wdCollapseStart
' Присваиваем имя 'find' объекту 'Find', который находится в объекте 'find_rng'.
' Сам не понимаю, что происходит здесь.
Set find = find_rng.find
'2. Настройка поиска.
' Что искать.
find.Text = "<[A-z]@>"
' Постановочные символы.
find.MatchWildcards = True
' Остановить поиск, когда будет достигнут конец области сносок.
find.Wrap = wdFindStop
'3. Поиск.
Do While find.Execute = True
' Удаление гиперссылок. Несколько гиперссылок может быть, если найдено много текста, например, целый абзац.
For i = find_rng.Hyperlinks.Count To 1 Step -1
find_rng.Hyperlinks(i).Delete
Next i
Loop
End Sub
Большое спасибо Вам! У меня все заменилось!
Вариант как в ответе 1, но можно проверить, есть или нет в гиперссылке нужный текст, с помощью 'Найти и заменить'.
Может быть этот способ будет быстрее и оптимальнее, чем в ответе 3.
Option Explicit для данного макроса значения не имеет.
Макрос
Sub Макрос()
' Отключение монитора (может это ускорит макрос).
Application.ScreenUpdating = False
'1. Удаление гиперссылок в страничных сносках.
If ActiveDocument.Footnotes.Count <> 0 Then
DelHyperlinks ActiveDocument.StoryRanges(wdFootnotesStory)
End If
'2. Удаление гиперссылок в концевых сносках.
If ActiveDocument.Endnotes.Count <> 0 Then
DelHyperlinks ActiveDocument.StoryRanges(wdEndnotesStory)
End If
' Включение монитора.
Application.ScreenUpdating = True
'3. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Private Sub DelHyperlinks(rng As Range)
Dim hyp As Hyperlink, i As Long
' Движение по всем гиперссылкам, которые есть в сносках, от последней к первой.
For i = rng.Hyperlinks.Count To 1 Step -1
' Присваиваем гиперссылке имя 'hyp'. Далее в коде будем обращатья к гиперссылке по имени 'hyp',
' это должно упростить чтение и написание макроса.
Set hyp = rng.Hyperlinks(i)
' Поиск в гиперссылке нужного текста.
With hyp.Range.find
' Что искать.
.Text = "<[A-z]@>"
' Подстановочные знаки.
.MatchWildcards = True
' Не искать за пределами гиперссылки.
.Wrap = wdFindStop
' Поиск.
If .Execute = True Then
' Удаление гиперссылки. Удаляется только гиперссылка, а текст остаётся.
hyp.Delete
End If
End With
Next i
End Sub