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

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

  1. выделяем диапазон с гиперссылками;
  2. жмем Ctrl+H.
    • Найти: .excel_vba
    • Заменить на: excel-vba
    • Жмем кнопочку "Параметры" и устанавливаем Область поиска - Формулы и снимаем галочку "Ячейка целиком"
  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

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

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

Скачать пример

  Пример замены гиперссылок.xls (58,0 КиБ, 12 786 скачиваний)

Так же см.:
Что такое гиперссылка?

Loading

34 комментария

  2. Пользователь скопировал к себе с сервера на комп файл, при этом адрес множества гиперссылок приняли вид "..\AppData\Roaming\Microsoft\Excel\Входящие,%20исходящие305293131975136761\ЭЛЕКТРОННЫЙ%20АРХИВ\Исходящие%202016%20г\Имя_файла". Текст ячеек имеет вид "ЭЛЕКТРОННЫЙ АРХИВ\Исходящие 2016 г\Имя_файла". Используя макрос, указываю диапазон проблемных ячеек. В поле "Что меняем" вставляю "..\AppData\Roaming\Microsoft\Excel\Входящие,%20исходящие305293131975136761\ЭЛЕКТРОННЫЙ%20АРХИВ\Исходящие%202016%20г", в поле "На что меняем" указываю путь "\\имя_сервера\имя_сетевой_шары\ЭЛЕКТРОННЫЙ АРХИВ\Исходящие 2016 г", но эффекта 0. Пробовал как диапазон так и 1 ячейку. В этом же файле создаю произвольную гиперссылку \\тест\тест и макрос её меняет на \\что_угодно\что_угодно.
    Буду рад помощи :)

    1. Я тоже так мучался пока не заметил, что макрос, если не удалить из диалогового окна его пример что заменять (".excel_vba") или не удалить пример на что заменять ("excel-vba"), он это прописывает в ведённые ваши данные... В итоге получается или он не находит то, что нужно заменить, или прописывает неверный путь на что нужно заменить (в ваш путь добавляет excel-vba и вы его не замечаете, а эксель не обманешь)
      Прежде чем ввести в диалоговое окно что-либо, надо удалить то, что там есть, т.е. нажать клавишу Del.

  3. Здравствуйте!
    Спасибо за макрос.
    Есть одно но, предлагает выбор диапазона, в котором нужна автозамена, я указываю диапазон, но... заменяются все имеющиеся на листе гиперссылки, а не только те, что выделяла (скопировала гиперссылки на несколько столбцов и теперь нужно изменить ссылку на ячейку с A1 на А2, А3 и т.д в этих столбцах).
    Подскажите, какую строку в первом предложенном Вами макросе нужно изменить?

    1. Елена, если честно - на знаю как такое получается. Диапазон для замены задается жестко при запросе и я пока не могу понять, как это он преобразуется во все ячейки листа. Вы сами ничего не меняли в коде макроса?
      Возможно, проблема с InputBox, конечно. Он может неверно отрабатывать при наличии условного форматирования на листе. Попробуйте вместо строки:

      Set rRange = Application.InputBox("Укажите диапазон для замены", "Выбор данных", Type:=8)

      записать

      Set rRange = Selection

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

  4. Дмитрий помогите пожалуйста, код идеально работает, но как сделать так, что бы код указывал "диапазон для замены", "что меняем" и "на что меняем" самостоятельно и зацикливал это действия до определенного момента. У меня в Столбце А указаны гиперссылки по 538 ячейку и в данных гиперссылках в конце стоит "=A" , "=AA" и так далее, нужно эти конечные значения заменить на цифры, для этого нужно что бы код брал ячейку, выделял в гиперссылке определенный элемент и заменял его на значение указанные в столбце Б к примеру

  5. Дорогой Дмитрий !
    Выражаю Вам свою бесконечную благодарность за решение проблемы коррекции гиперссылок путём
    применения Вашего замечательного скрипта !
    Сейчас уже 2021 год, а Ваше решение не теряет актуальности !

    Нижайший, Вам, поклон, Дмитрий, и наилучшие пожелания !

    С уважением, Леонид Жуков
    Москва, 2021 г , http://www.MCST.ru

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.