Почему слетают гиперссылки в excel

Почему слетают гиперссылки в excel

2010 — Слетают гирессылки в Excel.

Сообщения: 171
Благодарности: 4

Добрый день!
Имеется файл xlsx расположенный на сетевом диске. В нем несколько десятков листов, на которые ведут гиперссылки с первого листа.
С файлом работают несколько человек ( у файла не открыт общий доступ средствами экселя), (у кого то установлен 2010 у кого то 2007 Office)
Периодически гиперссылки перестают работать, сам путь к листу (в гиперссылке) не меняется, а пропадает ссылка на R1C1.
Помогите разобраться в чем может быть дело. В нете ничего подобного не смог найти.
Благодарю!

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

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

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

Причина

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

Решение

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

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

Статус

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

Макрос для исправления повреждённых гиперссылок во всей книге 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

• 69324 просмотра

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

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

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

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

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