Excel массовая замена гиперссылок

Хитрости »

30 Май 2011              156199 просмотров

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

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

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

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

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

 
Чтобы

заменить гиперссылки только в выделенных объектах

необходимо строку

For Each oSh In ActiveSheet.Shapes

заменить на такую:

For Each oSh In Selection.ShapeRange

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

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

  Пример замены гиперссылок.xls (58,0 KiB, 11 331 скачиваний)

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

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

  Плейлист   Видеоуроки

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



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

Источник

Всем привет! Как-то на работе столкнулся на работе с интересной задачей. Во время работе Excel выдал ошибку и закрыл окно. После попытки открыть файла оказалось, что все гиперссылки в документе изменили часть своего пути.

Решение

  1. Открываем VBA (Visual Basic for Applications) через Alt+F11
  2. В окне Project-VBAProject (левой верхнее) правой кнопкой мыши делаем Insert — Module
  3. В появившемся большом окне вставляем код макроса вида с нашими ссылками (первая ссылка — что нужно поменять, вторая — на что нужно поменять)
Sub Hyper()
For i = 1 To ActiveSheet.Hyperlinks.Count
    ActiveSheet.Hyperlinks(i).Address = Replace(ActiveSheet.Hyperlinks(i).Address, "../../../AppData/Roaming/Microsoft/Excel/", "UsersUserDesktopФирмаДоговора")
Next
End Sub

      4. Закрываем VBA.

       5. Через Сервис — Макрос — Макросы ( или по Alt+F8) выбираем макрос и нажимаем «Выполнить».

Пути гиперссылкок будут заменены. Проверено — работает!

Спасибо за помощь http://forum.ixbt.com/topic.cgi?id=23:33826

Posted in WINDOWS and tagged excel.

Источник
 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

Доброе время суток!
У меня такая проблема:
Есть два файла, один основной(1), другой второстепенный(2). Оба находятся в одной папке. Каждая ячейка в файле 1 имеет гиперссылку на определенную ячейку в файле 2 и также обратно, для возвращения в основной файл.
В файле 1 гиперссылки не имели полного адреса расположения файла 2 в сетевой папке, что давало возможность копировать папку с обоими файлами, допустим, на флешку, и не ломая гиперссылки. Фактически адрес ссылки выглядел так: «Файл 2.xlsm#’Имя Листа’!Номер ячейки»
Сейчас на сетевом ресурсе что-то произошло, и в гиперссылках появились лишние адреса. В итоге всё начало выглядить так: /../../../Папка/Папка/»Файл 2.xlsm#’Имя Листа’!Номер ячейки». Можно ли при помощи какого-либо макроса удалить часть адреса гиперссылки, ну или заменить на пустоту сразу во всех гиперссылках документа?Их больше тысячи. Хэлп ми!!!
 

tgoring

Пользователь

Сообщений: 3
Регистрация: 19.06.2014

#2

19.06.2014 14:30:53

Ссылки все на одном листе?

Код 
Sub FixHyperlinks()
    Dim wks As Worksheet
    Dim hl As Hyperlink
    Dim sOld As String
    Dim sNew As String

    Set wks = ActiveSheet
    sOld = "c:" 
    sNew = "S:Network"
    For Each hl In wks.Hyperlinks
        hl.Address = Replace(hl.Address, sOld, sNew)
    Next hl
End Sub

Изменить нужно то, что в кавычках.
 

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

нет, ссылки во всей книге. в итоге надо чтобы удалилась чать пути /../../../Папка/Папка/ и осталось только название файла и ячейки….
 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

The_Prist,это мне не помогло, дело в том, что каждая гиперссылка в файле 1 имеет адрес разной ячейки второстепенного файла, поэтому мне необходимо только удалить первую часть адреса
 

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Т.е. попробовать лень? Код принимает в качестве аргумента не полный адрес — а часть. Как раз первую часть ссылок(одинаковую) указываете. Если надо удалить — в качестве заменяемого адреса пусто.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

#7

19.06.2014 17:45:19

The_Prist, не думаю, что я ленивый человек. Пробовал я много чего. К примеру:

Код 
Sub test2()
On Error Resume Next
Dim hl As Hyperlink, s As String, sh As Worksheet
s = "../../../../Maintenance/Транспортная%20сеть/Транспортная%20сеть/" ' часть гиперссылки, подлежащая удалению
For Each sh In ActiveWorkbook.Worksheets
For Each hl In sh.Hyperlinks
If hl.Address Like s & "*" Then hl.Address = Replace(hl.Address, s, ""  
Next
Next sh
End Sub

комп думает три секунды и…..ничего не меняется
 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

Кнопка для форматирования кода в сообщении

 

Finswimmer

Пользователь

Сообщений: 424
Регистрация: 01.03.2014

#9

19.06.2014 17:49:07

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

Код 
With ActiveSheet
    For i = 1 To .Hyperlinks.Count
            .Hyperlinks(i).Range.Offset(0, 1).Value = .Hyperlinks(i).Address
      Next i
End With
 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

#10

19.06.2014 17:49:56

Спасибо vikttur, ,

Код 
Sub test2()
    On Error Resume Next
    Dim hl As Hyperlink, s As String, sh As Worksheet
    s = "../../../../COMMON/TDMaintenance/Транспортная%20сеть/Транспортная%20сеть/" ' часть гиперссылки, подлежащая удалению
    For Each sh In ActiveWorkbook.Worksheets
        For Each hl In sh.Hyperlinks
            If hl.Address Like s & "*" Then hl.Address = Replace(hl.Address, s, "")
        Next
    Next sh
End Sub
 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

#11

19.06.2014 17:53:10

пробовал также:

Код 
Sub ЗаменаИспорченныхГиперссылок()
    On Error Resume Next
    Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
    ' часть гиперссылки, подлежащая замене
   oldString = "../../../../COMMON/TDMaintenance/Транспортная%20сеть/Транспортная%20сеть/"
    ' на что заменяем
   newString = ""
    For Each sh In ActiveWorkbook.Worksheets    ' перебираем все листы в активной книге
       For Each hl In sh.Hyperlinks    ' перебираем все гиперссылки на листе
           If hl.Address Like oldString & "*" Then
                hl.Address = Replace(hl.Address, oldString, newString)
            End If
        Next
    Next sh
End Sub

не хочет работать и все тут. Я уже и в параметрах безопасности макросам все разрешил…
 
 

Игорь

Пользователь

Сообщений: 3631
Регистрация: 23.12.2012

Кросс:

http://programmersforum.ru/showthread.php?t=262907Kazakoff

, нет файла — нет помощи
Я же просил с вас файл с ОДНОЙ гиперссылкой
неужто пустой файл, содержащий ОДНУ проблемную гиперссылку, может быть секретным?
 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

я прошу прощения.

вот

создал пример, там должен быть макрос test2. Может я чего не догоняю, но он не срабатывает.
 

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Попробовал заменить «……..COMMONTDMaintenanceТранспортная сетьТранспортная сеть» на пусто своим кодом — все заменилось, никаких проблем. И код в книге работает.
Одно не пойму — зачем Вы знаки «%20» добавили в адреса для замены? Их ведь нет в гиперссылках изначально. Может поэтому не работает? А Вы все проблемы на нормальные коды валите?

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

программа сама почему-то заменила все пробелы на «%20»
 

The_Prist

Пользователь

Сообщений: 14181
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Какая такая программа?
Попробуйте для своих ячеек посмотреть адреса гиперссылок и как они выглядят реально:

  • Как получить адрес гиперссылки из ячейки

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Kazakoff

Пользователь

Сообщений: 9
Регистрация: 19.06.2014

The_Prist,большущее Вам спасибо, поставили меня на правильный путь!!! %20 — это эксель так заменил все пробелы в ссылках. и я тупо копировал путь из ссылки в макрос с процентами, убрал и все получилось. Спасибо, что потратили на меня время!!
 

4vaker

Пользователь

Сообщений: 26
Регистрация: 04.08.2014

#19

20.08.2014 20:05:03

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

Код 
=ЕСЛИ((Extract_Value_ADO_Sh("\udc10SvodkaНачальник НГДУ20148 июльДобыча";$K$3;"Доб.по ДНС";"B14"))="";"";(Extract_Value_ADO_Sh("\udc10SvodkaНачальник НГДУ20148 июльДобыча";$K$3;"Доб.по ДНС";"B14")))

Например «июль» на «август».
Пробовал вводить код из статьи массовых изменений, но ругается на ячейку «$К$3»
 

а через обычную замену Ctrl-H по части формулы — не работает?
 

4vaker

Пользователь

Сообщений: 26
Регистрация: 04.08.2014

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

зачем жать Enter, если есть кнопка «заменить все»?
 

4vaker

Пользователь

Сообщений: 26
Регистрация: 04.08.2014

как же Вы не понимаете, мне нужно указать диапазон, потому что в некоторых ячейках менять ту же самую часть формулы не надо
 

как же мне было понять, если вы об этом не говорили?
А чем будет отличаться выбор диапазона на листе от выбора диапазона в макросе? Жесткой заданностью? или критерием каким-то?
Ну, каков файл примера — таково и решение.
 

4vaker

Пользователь

Сообщений: 26
Регистрация: 04.08.2014

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

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

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

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

 

4vaker

Пользователь

Сообщений: 26
Регистрация: 04.08.2014

Нужно из столба «Е» сделать столб «Х».
 

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#28

21.08.2014 11:01:10

Замените:

Код 
"\usndc10SvodkaНачальник НГДУ20148 сентябрьДобыча ТПП"

на

Код 
"\usndc10SvodkaНачальник НГДУ20148 "&строчн(ТЕКСТ(X$3;"ММММ"))&"Добыча ТПП"

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

 

Максим Зеленский

Пользователь

Сообщений: 4646
Регистрация: 11.06.2014

Microsoft MVP

#29

21.08.2014 11:38:37

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

Код 
sWhatRep = InputBox("Что меняем?", "Ввод данных", """" & "\usndc10SvodkaНачальник НГДУ20148 августДобыча ТПП" & """" & ";$K$3;" & """Доб.по ДНС""" & ";" & """B14""")
sRep = InputBox("На что меняем?", "Ввод данных", """" & "\usndc10SvodkaНачальник НГДУ20148 декабрьДобыча ТПП" & """" & ";$K$3;" & """Доб.по ДНС""" & ";" & """B14""")

только макрос ничего не меняет, так как нет гиперссылок в ячейках.

PS

F1 творит чудеса

 

4vaker

Пользователь

Сообщений: 26
Регистрация: 04.08.2014

#30

21.08.2014 13:00:39

Кажется я не с того начал. Значит давайте сначала.
Самый простой способ казалось бы ctrl+H у меня НЕ РАБОТАЕТ, поэтому я к вам и обратился.
Допустим я копирую десять ячеек из одного столба в другой, выделяю скопированные ячейки, жму ctrl+h, делаю всё по инструкции, если жать «заменить», то каждую из десяти ячеек он мне предлагает заменить, соответственно необходимо нажимать 10 раз энтер — это фуфло если у меня 200 ячеек, понятно. Если я жму «ЗАМЕНИТЬ ВСЕ», то плевать, что я выделил эти 10 ячеек, он меняет ПОЛНОСТЬЮ ВСЕ ЗНАЧЕНИЯ НА ЛИСТЕ. А мне нужно, чтобы он менял только то, что мне надо. Вот и всё.
Я вам даже больше скажу. Просто заполнив некоторые ячейки словом «август», и прописывая код, указанный в статье по массовой замене, он у меня спрашивает по порядку, что хочу поменять, я ему пишу «август», он спрашивает на что хочу поменять, я пишу «сентябрь», он просит выделить диапазон, я выделяю диапазон со словами «август» и БАМ, ничего не происходит, как был август так и остался.

Изменено: 4vaker — 21.08.2014 13:12:07
Источник

Qairat

Qairat

@Qairat

frontend developer, angular 2+

Всем Привет!
Такая ситуация. Есть такой файл:
3435c9b13c3c427095e62dcef46e96f6.JPG
И везде на гипперссылках написано слово parsing/Licenses/Details/и свое значение.
d706d3e891f64af4b71413c5d556bf44.JPG
Теперь мне надо поменять там слово parsing на другое слово.
Как можно сделать сразу везде?
Помогите.
Там более 20 тысяч строк.


  • Вопрос задан

    более трёх лет назад

  • 2262 просмотра

Alt+F11

Sub FixLinks()
    Dim hLink As Hyperlink
    Dim sOld As String
    Dim sNew As String

    sOld = "http://parsing"
    sNew = "http://newsite"
    
    For Each hLink In ActiveSheet.Hyperlinks
        hLink.Address = Replace(hLink.Address, sOld, sNew)
    Next hLink
End Sub

выполнить

Пригласить эксперта


  • Показать ещё
    Загружается…

14 апр. 2023, в 04:52

5000 руб./за проект

14 апр. 2023, в 01:55

1000 руб./в час

13 апр. 2023, в 23:50

3000 руб./за проект

Минуточку внимания

Источник

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

Join @AdmNtsRu on Telegram

Смотрите также:

Источник

Понравилась статья? Поделить с друзьями:
  • Excel массив в фигурных скобках
  • Excel массивы условное форматирование
  • Excel массив в одну строку
  • Excel массивы с условием
  • Excel массив в одной ячейке