Заменить все адреса гиперссылок, содержащие ненужные URL на необходимый адрес- Visual Basic(Бейсик)

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

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)

Leave a Comment