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

Гиперссылки удаляются или недопустимы после сортировки ячеек, содержащих эти гиперссылки в Excel

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

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

Причина

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

Решение

Если эта проблема возникнет, исправьте гиперссылки вручную. Это можно сделать одним из описанных ниже способов.

Если в Excel была удалена гиперссылка из ячейки, выделите ее и в меню Вставка выберите пункт Гиперссылка . Введите правильный адрес в поле адрес и нажмите кнопку ОК.Примечание. Если в Excel 2007 гиперссылка удалена из ячейки, выделите ее, а затем в группе » ссылки » на вкладке » Вставка » нажмите кнопку » Гиперссылка «. В диалоговом окне Вставка гиперссылки в поле адрес введите правильный адрес и нажмите кнопку ОК. -или-
Если гиперссылка ссылается на неверный адрес, щелкните ячейку правой кнопкой мыши и выберите команду Изменить гиперссылку. В диалоговом окне изменение гиперссылки измените адрес в поле адрес и нажмите кнопку ОК.

Статус

Корпорация Майкрософт подтверждает наличие этой проблемы в своих продуктах, которые перечислены в разделе «Применяется к».

Восстановление битых ссылок Excel

Бывает так, что при перемещении файла Excel в нем “ломаются” ссылки на другие сетевые или локальные файлы, кроме того при открытии вы наблюдаете ошибку:

Все ссылки разом можно исправить несложным VBS скриптом https://excelvba.ru/code/replace_hyperlinks:

Sub ЗаменаИспорченныхГиперссылок2() On Error Resume Next Dim hl As Hyperlink, oldString$, newString$, sh As Worksheet, n&, msg$, coll As New Collection, Item ' часть гиперссылки, подлежащая замене oldString color:#dd5533" >../../AppData/Roaming/Microsoft/Excel/" ' на что заменяем newString color:#dd5533" >C:\Users\Admin\Desktop\ОТЧЁТЫ ВСЕ\" For Each sh In ActiveWorkbook.Worksheets ' перебираем все листы в активной книге For Each hl In sh.Hyperlinks ' перебираем все гиперссылки на листе ' Debug.Print hl.Address If (hl.Address Like oldString & "*") Or (hl.Address Like Replace(oldString, "/", "\") & "*") Then hl.Address = Replace(hl.Address, oldString, newString, , , vbTextCompare) hl.Address = Replace(hl.Address, Replace(oldString, "/", "\"), newString, , , vbTextCompare) n = n + 1 Else If InStr(1, hl.Address, "mailto", vbTextCompare) = 0 Then coll.Add hl.Address, UCase(hl.Address) End If Next Next sh For Each Item In coll msg$ = msg$ & Item & vbNewLine Next MsgBox "Заменено гиперссылок: " & n & IIf(Len(msg$), vbNewLine & vbNewLine & _ "Также в файле найдены ссылки на:" & vbNewLine & msg$, ""), vbInformation End Sub

1. Нажимаем Alt+F11
2. В меню открывшегося окна Microsoft Visual Basic выбираем Insert…—Module
3. В открывшемся документе вставляем код макроса (см. выше)
4. Закрываем окно Microsoft Visual Basic
5. Нажимаем Alt+F8
6. В открывшемся окне выделяем созданный макрос и запускаем

При замене путей на свои в макросе следите за корректностью кодировки.

Макрос для исправления повреждённых гиперссылок во всей книге Excel

Макрос может быть полезен для замены абсолютных гиперссылок на относительные, а также помогает вернуть работоспособность ссылок после случайного сохранения файла Excel в другой папке (на другом диске).

Если нужно заменить несколько вариантов неверных ссылок, код будет таким:

Sub ЗаменаИспорченныхГиперссылок_2() On Error Resume Next Dim hl As Hyperlink, newString$, sh As Worksheet ' часть гиперссылки, подлежащая замене oldString1 = "C:\Documents and settings\Бухгалтер\1" oldString2 = "C:\Documents and settings\Бухгалтер\2" ' на что заменяем newString = "\\адрес_сервера" For Each sh In ActiveWorkbook.Worksheets ' перебираем все листы в активной книге For Each hl In sh.Hyperlinks ' перебираем все гиперссылки на листе If hl.Address Like oldString1 & "*" Then hl.Address = Replace(hl.Address, oldString1, newString) If hl.Address Like oldString2 & "*" Then hl.Address = Replace(hl.Address, oldString2, newString) Next Next sh End Sub

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

Sub ЗаменаИспорченныхГиперссылок2() On Error Resume Next Dim hl As Hyperlink, oldString$, newString$, sh As Worksheet, n&, msg$, coll As New Collection, Item ' часть гиперссылки, подлежащая замене oldString = "../../AppData/Roaming/Microsoft/Excel/" ' на что заменяем newString = "C:\Users\Admin\Desktop\ОТЧЁТЫ ВСЕ\" For Each sh In ActiveWorkbook.Worksheets ' перебираем все листы в активной книге For Each hl In sh.Hyperlinks ' перебираем все гиперссылки на листе ' Debug.Print hl.Address If (hl.Address Like oldString & "*") Or (hl.Address Like Replace(oldString, "/", "\") & "*") Then hl.Address = Replace(hl.Address, oldString, newString, , , vbTextCompare) hl.Address = Replace(hl.Address, Replace(oldString, "/", "\"), newString, , , vbTextCompare) n = n + 1 Else If InStr(1, hl.Address, "mailto", vbTextCompare) = 0 Then coll.Add hl.Address, UCase(hl.Address) End If Next Next sh For Each Item In coll msg$ = msg$ & Item & vbNewLine Next MsgBox "Заменено гиперссылок: " & n & IIf(Len(msg$), vbNewLine & vbNewLine & _ "Также в файле найдены ссылки на:" & vbNewLine & msg$, ""), vbInformation End Sub

69310 просмотров