Как заменить все адреса гиперссылок, содержащие ненужные URL на необходимый адрес?

Категория: Basic
2012-08-20 15:10:54

Предположим, что во всех рабочих листах - текущей рабочей книги, нам необходимо найти все гиперссылки, адреса которых содержат ненужные URL ссылки, в данном примере, это URL поисковиков, которые, к сожалению, либо прекратили своё существование, либо приостановили свою деятельность, и заменить найденный адрес и текст в ячейке, на "http://www.yandex.ru" и "Яндекс. Найдётся всё", соответственно.

code: #vba
Private Sub ReplaceChooseHyperlinks()
    Dim iWorksheet As Worksheet, iHyperlink As Hyperlink, iArray
 
    iArray = Array("turtle.ru", "punto.ru", "webfind.ru")
 
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
         .Calculation = xlManual
         For Each iWorksheet In ThisWorkbook.Worksheets
             For Each iHyperlink In iWorksheet.Hyperlinks
                 If .Count(.Search(iArray, iHyperlink.Address)) Then
                    iHyperlink.Address = "http://www.yandex.ru"
                    If iHyperlink.Type = msoHyperlinkRange Then
                       iHyperlink.Range.Value = "Яндекс. Найдётся всё"
                       'iHyperlink.TextToDisplay = "Яндекс. Найдётся всё"
                    End If
                 End If
             Next
         Next
         .Calculation = xlAutomatic
         .EnableEvents = True
         .ScreenUpdating = True
    End With
End Sub
  • Если рабочий лист + ячейки защищены, то при использовании Range.Value Вы получите ошибку, которую можно избежать
  • Для того, чтобы перебрать гиперссылки, созданные с помощью стандартной функции рабочего листа =ГИПЕРССЫЛКА(), используйте поиск (т.е. метод Find и FindNext)

Актуально для MS Excel 97, 2000, XP

Поделиться:

Похожие статьи:

теги: ссылка, vba, макросы, гиперссылки, адрес