В этой статье я покажу как можно быстро и качественно изменить адреса гиперссылок на листе 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 КиБ, 13 340 скачиваний)

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

Loading

38 комментариев

  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

  8. Добрый день. Несколько лет пользовался вашим макросом для переименования гиперссылок. Суперовская тема! Но уже второй раз отказывается исполнять макрос. Все делает, как надо, но адрес не меняет? Вся надежда на вас :)

    1. MaratRR, я не экстрасенс, чтобы угадать, что у Вас в книге, какие там гиперссылки. Исходных данных ровно 0. Тот факт, что макрос два раза уже не меняет не означает, что он не работает как надо - скорее всего данные в файле не те, которые ожидались.

      1. Пардон за некорректность. Так долго выбирал светофоры и мотоциклы на капче, что не смог правильно сформулировать вопрос :)
        Есть подозрение, что у меня ексель не видит, что внутри гиперссылок есть текст с адресом. Во всех ячейках таблицы работает поиск, а в столбце с гиперссылками нет. По этой причине и макрос работает, но не находит то, что необходимо заменить. На всякий случай все возможные галки в настройках проверил, не нашел ничего. Может есть некая стандартная глупость в настройках, которую я мог совершить? Или это уже дефект необновляемого несколько лет екселя?

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

This site uses Akismet to reduce spam. Learn how your comment data is processed.