В этой статье я покажу как можно быстро и качественно изменить адреса гиперссылок на листе Excel.
Существуют ситуации, когда на листе есть много гиперссылок(если еще на знакомы с гиперссылками - Что такое гиперссылка?) на различные папки или интернет ресурсы. И иногда случаются ситуации когда адреса этих гиперссылок надо поменять. Как правило это происходит если либо домен сменился, либо на сервере добавилась директория и эти изменения надо отразить в гиперссылках, либо все просто было перемещено в другую папку. Для примера возьмем такие исходные данные: надо заменить текст ссылки
Прежде чем начать замену необходимо еще определить каким способом установлена гиперссылка. Если установлена через формулу
- выделяем диапазон с гиперссылками;
- жмем
Ctrl +H .- Найти:
.excel_vba - Заменить на:
excel-vba - Жмем кнопочку "Параметры" и устанавливаем Область поиска - Формулы и снимаем галочку "Ячейка целиком"
- Найти:
- Жмем "Заменить все"
Теперь адреса ссылок должны поменяться.
Все гораздо сложнее, если гиперссылки были созданы через стандартное меню: правый клик мыши на ячейке - Гиперссылка. Тут фокус с заменой через
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 (или создаем кнопку для вызова макроса на листе) - в первом диалоговом окне указываем какой текст заменить
- во втором диалоговом окне на что заменить указанный в первом окне текст
Гиперссылки всех объектов на листе будут изменены. Если у объекта нет гиперссылки - объект будет пропущен.
Чтобы
заменить на такую:
тогда надо будет выделить объекты на листе, для которых необходимо заменить гиперссылки, и запустить макрос.
Пример замены гиперссылок.xls (58,0 КиБ, 13 340 скачиваний)
Так же см.:
Что такое гиперссылка?
Класс, все работает, молодец! Спасибо!
Пользователь скопировал к себе с сервера на комп файл, при этом адрес множества гиперссылок приняли вид "..\AppData\Roaming\Microsoft\Excel\Входящие,%20исходящие305293131975136761\ЭЛЕКТРОННЫЙ%20АРХИВ\Исходящие%202016%20г\Имя_файла". Текст ячеек имеет вид "ЭЛЕКТРОННЫЙ АРХИВ\Исходящие 2016 г\Имя_файла". Используя макрос, указываю диапазон проблемных ячеек. В поле "Что меняем" вставляю "..\AppData\Roaming\Microsoft\Excel\Входящие,%20исходящие305293131975136761\ЭЛЕКТРОННЫЙ%20АРХИВ\Исходящие%202016%20г", в поле "На что меняем" указываю путь "\\имя_сервера\имя_сетевой_шары\ЭЛЕКТРОННЫЙ АРХИВ\Исходящие 2016 г", но эффекта 0. Пробовал как диапазон так и 1 ячейку. В этом же файле создаю произвольную гиперссылку \\тест\тест и макрос её меняет на \\что_угодно\что_угодно.
Буду рад помощи :)
Я тоже так мучался пока не заметил, что макрос, если не удалить из диалогового окна его пример что заменять (".excel_vba") или не удалить пример на что заменять ("excel-vba"), он это прописывает в ведённые ваши данные... В итоге получается или он не находит то, что нужно заменить, или прописывает неверный путь на что нужно заменить (в ваш путь добавляет excel-vba и вы его не замечаете, а эксель не обманешь)
Прежде чем ввести в диалоговое окно что-либо, надо удалить то, что там есть, т.е. нажать клавишу Del.
Здравствуйте!
Спасибо за макрос.
Есть одно но, предлагает выбор диапазона, в котором нужна автозамена, я указываю диапазон, но... заменяются все имеющиеся на листе гиперссылки, а не только те, что выделяла (скопировала гиперссылки на несколько столбцов и теперь нужно изменить ссылку на ячейку с A1 на А2, А3 и т.д в этих столбцах).
Подскажите, какую строку в первом предложенном Вами макросе нужно изменить?
Елена, если честно - на знаю как такое получается. Диапазон для замены задается жестко при запросе и я пока не могу понять, как это он преобразуется во все ячейки листа. Вы сами ничего не меняли в коде макроса?
Возможно, проблема с InputBox, конечно. Он может неверно отрабатывать при наличии условного форматирования на листе. Попробуйте вместо строки:
записать
Set rRange = Selection
тогда перед запуском макроса надо будет выделить нужные ячейки и замена будет произведена только в них.
Дмитрий помогите пожалуйста, код идеально работает, но как сделать так, что бы код указывал "диапазон для замены", "что меняем" и "на что меняем" самостоятельно и зацикливал это действия до определенного момента. У меня в Столбце А указаны гиперссылки по 538 ячейку и в данных гиперссылках в конце стоит "=A" , "=AA" и так далее, нужно эти конечные значения заменить на цифры, для этого нужно что бы код брал ячейку, выделял в гиперссылке определенный элемент и заменял его на значение указанные в столбце Б к примеру
Дорогой Дмитрий !
Выражаю Вам свою бесконечную благодарность за решение проблемы коррекции гиперссылок путём
применения Вашего замечательного скрипта !
Сейчас уже 2021 год, а Ваше решение не теряет актуальности !
Нижайший, Вам, поклон, Дмитрий, и наилучшие пожелания !
С уважением, Леонид Жуковhttp://www.MCST.ru
Москва, 2021 г ,
Спасибо, Автор! дай Бог здоровья!
Дмитрий, спасибо!
Почти 3000 замен меньше чем за 10 минут!
Здоровья и благополучия вам!
Добрый день. Несколько лет пользовался вашим макросом для переименования гиперссылок. Суперовская тема! Но уже второй раз отказывается исполнять макрос. Все делает, как надо, но адрес не меняет? Вся надежда на вас :)
MaratRR, я не экстрасенс, чтобы угадать, что у Вас в книге, какие там гиперссылки. Исходных данных ровно 0. Тот факт, что макрос два раза уже не меняет не означает, что он не работает как надо - скорее всего данные в файле не те, которые ожидались.
Пардон за некорректность. Так долго выбирал светофоры и мотоциклы на капче, что не смог правильно сформулировать вопрос :)
Есть подозрение, что у меня ексель не видит, что внутри гиперссылок есть текст с адресом. Во всех ячейках таблицы работает поиск, а в столбце с гиперссылками нет. По этой причине и макрос работает, но не находит то, что необходимо заменить. На всякий случай все возможные галки в настройках проверил, не нашел ничего. Может есть некая стандартная глупость в настройках, которую я мог совершить? Или это уже дефект необновляемого несколько лет екселя?