Как массово изменить гиперссылки в Excel?

В этой статье я покажу как можно быстро и качественно изменить адреса гиперссылок на листе Excel.

Существуют ситуации, когда на листе есть много гиперссылок(если еще на знакомы с гиперссылками на различные папки или интернет ресурсы. И иногда случаются ситуации когда адреса этих гиперссылок надо поменять. Как правило это происходит если либо домен сменился, либо на сервере добавилась директория и эти изменения надо отразить в гиперссылках, либо все просто было перемещено в другую папку. Для примера возьмем такие исходные данные: надо заменить текст ссылки <f-с1>.excel_vba</f-с1> на текст <f-с2>excel-vba</f-с2>.
Прежде чем начать замену необходимо еще определить каким способом установлена гиперссылка. Если установлена через формулу ГИПЕРССЫЛКА, то все просто:

1. выделяем диапазон с гиперссылками;
2. жмем Ctrl+H.
   • Найти: <f-с1>.excel_vba</f-с1>
   • Заменить на: <f-с2>excel-vba</f-с2>
   • Жмем кнопочку «Параметры» и устанавливаем Область поиска — Формулы и снимаем галочку «Ячейка целиком«
3. Жмем «Заменить все«

Теперь адреса ссылок должны поменяться.

Все гораздо сложнее, если гиперссылки были созданы через стандартное меню:

правый клик мыши на ячейке — Гиперссылка. Тут фокус с заменой через Ctrl+H не пройдет. В таких случаях придется прибегнуть к помощи VBA(Visual Basic for Applications) или как чаще называют эти коды — макросы. Текст такого макроса:

Sub Replace_Hyperlink()
    Dim rCell As Range, rRange As Range, sWhatRep As String, sRep As String
    On Error Resume Next
    Set rRange = Application.InputBox("Укажите диапазон для замены", "Выбор данных", Type:=8)
    If rRange Is Nothing Then Exit Sub
    sWhatRep = InputBox("Что меняем?", "Ввод данных", ".excel_vba")
    sRep = InputBox("На что меняем?", "Ввод данных", "excel-vba")
    If sWhatRep = "" Then Exit Sub
    If sRep = "" Then
        If MsgBox("Хотите заменить " & sWhatRep & " на пусто?", vbCritical + vbYesNo, "Предупреждение") = vbNo Then Exit Sub
    End If
    Application.ScreenUpdating = 0
    For Each rCell In rRange
        If rCell.Hyperlinks.Count > 0 Then
            If rCell.Hyperlinks(1).Address = rCell.Value Then
                rCell = Replace(rCell.Value, sWhatRep, sRep)
            End If
            If rCell.Hyperlinks(1).Address <> "" Then
                rCell.Hyperlinks(1).Address = Replace(rCell.Hyperlinks(1).Address, sWhatRep, sRep)
            End If
            If rCell.Hyperlinks(1).SubAddress <> "" Then
                rCell.Hyperlinks(1).SubAddress = Replace(rCell.Hyperlinks(1).SubAddress, sWhatRep, sRep)
            End If
        End If
    Next rCell
    Application.ScreenUpdating = 1
End Sub

Как все это использовать:

• создаем стандартный модуль и помещаем в него код макроса выше
• жмем Alt+F11 и выбираем макрос Replace_Hyperlink (или создаем кнопку для вызова макроса на листе)
• в первом диалоговом окне указываем в каком диапазоне надо найти гиперссылки и заменить в них адрес
• во втором диалоговом окне указываем какой текст заменить
• в третьем диалоговом окне указываем на что заменить указанный в первом окне текст

Примерно так же можно заменить гиперссылки в объектах на листе(например, картинках и кнопках):

Sub Replace_Hyperlink_inShape()
    Dim oSh As Shape, sWhatRep As String, sRep As String
    Dim s As String
 
    sWhatRep = InputBox("Что меняем?", "Ввод данных", "www.excel-vba.com")
    sRep = InputBox("На что меняем?", "Ввод данных", "www.excel-vba.ru")
 
    On Error Resume Next
    For Each oSh In ActiveSheet.Shapes
        s = ""
        s = oSh.Hyperlink.Address
        If s <> "" Then
            oSh.Hyperlink.Address = Replace(oSh.Hyperlink.Address, sWhatRep, sRep)
        End If
    Next
End Sub

Данные код работает почти так же как и предыдущий:

• создаем стандартный модуль и помещаем в него код макроса выше
• жмем Alt+F11 и выбираем макрос Replace_Hyperlink_inShape (или создаем кнопку для вызова макроса на листе)
• в первом диалоговом окне указываем какой текст заменить
• во втором диалоговом окне на что заменить указанный в первом окне текст

Гиперссылки всех объектов на листе будут изменены. Если у объекта нет гиперссылки — объект будет пропущен.

Чтобы заменить гиперссылки только в выделенных объектах необходимо строку
For Each oSh In ActiveSheet.Shapes
заменить на такую:
For Each oSh In Selection.ShapeRange
тогда надо будет выделить объекты на листе, для которых необходимо заменить гиперссылки, и запустить макрос.

Скачать пример:   Пример замены гиперссылок.xls (58,0 KiB, 8 817 скачиваний)

За материал поклон Дмитрию: https://www.excel-vba.ru/chto-umeet-excel/kak-massovo-izmenit-giperssylki/