Забыли пароль?


Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (17)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (64)
Разное (41)
Баги и глюки Excel (4)

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

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

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

  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 KiB, 7 689 скачиваний)

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


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки
Обсуждение: 30 комментариев
  1. Огромное спасибо за пост...
    Очень выручили и избавили от массы рутинной работы по восстановлению слетевших ссылок.

  2. Андрей:

    Классный макрос! Не думал, что все можно с ним так легко привести в порядок))

  3. Виталий:

    Отличный макрос.
    Респект.

  4. Михаил:

    Потрясающе!
    Автору - долгих лет и процветания!
    Спасибо, что есть добрые люди, спасибо за помощь!

  5. babkakoshka:

    Спасибо за макрос.
    А можно ли макросом изменить гиперссылки во всех закрытых книгах документа?

  6. babkakoshka:

    "Укажите диапазон для замены"...
    А как в макросе указать конкретный диапазон, например: U5:U177? Спасибо.

  7. Денис:

    Всем привет. нужна помощь!!! В общем есть таблица эксель, она сохранена на сервере, к ней имеют доступ несколько компьютеров. проблема в том что не открываются гиперссылки направленые на папки лежащие на этом же сервере. гиперссылки внутри таблицы и направленные на сайты в интернете работают без пробле. также при обработке таблицы когдя я ее хочу сохранить мне пишет что я изменения не могли быть сохранены на сервере. если я вручную обновляю одну гиперссылку на папку то она начинает работать. но только вовремя этого сеанса. при новом открытии она опять не работает. подскажите как можно решить проблему. и как можно одной командой обновить все гиперссылки в таблице. очень жду ответа, спасибо!!!

  8. спасибо за скрипт! Очень полезный, выручил. Файловый сервер перенесли, а там люди годами работали над документами...

  9. Alexey:

    Здравствуйте!

    Столкнулся с такой же проблемой по изменению гиперссылок. Данный макрос отлично изменяет часть моих гиперссылок(например, названия конечных файлов), но не изменяет изначальный путь(Т.е. изменить название харда с "C" на "F" не удается). Кто знает, с чем это связано? Заранее благодарю

    • Трудно сказать. Т.е. все остальное заменяется, а первые буквы нет? Уверены, что в гиперссылке именно имя диска содержится? Может быть там путь сетевой указан - типа \\server\?
      Проверьте реальный текст гиперссылки функцией из статьи: Как получить адрес гиперссылки из ячейки

      • Alexey:

        Гениально! Фактический адрес ссылки отличался от того, что отображался в ячейке. Спасибо огромное за сам макрос и за подсказку с реальной ссылкой. Где на сайте кошельки для развития проекта?

  10. Благодарен! Дуже вдячний! Дякую!

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2020 Excel для всех   Войти