Макрос для исправление повреждённых гиперссылок во всей книге: Sub ЗаменаИспорченныхГиперссылок() On Error Resume Next Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet ' часть гиперссылки, подлежащая замене oldString = "C:\Documents and settings\Бухгалтер\Application data" ' на что заменяем 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 Макрос может быть полезен для замены абсолютных гиперссылок на относительные, а также помогает вернуть работоспособность ссылок после случайного сохранения файла Excel в другой папке (на другом диске).
|
|||
Комментарии
а по-моему гиперссылки и ссылки на файлы итак считаются одним и тем же. для них создана только одна кнопочка там в меню "изменение гиперссылки" слева
то есть
...создать ссылки на сайты...
>> В меню "Изменение Гиперссылки" слева есть возможность выбора:
это для того, чтобы можно было мышкой создать ссылку. а так, эти кнопки особой роли не играют.
можно при помощи этих кнопок создать ссылки на файлы, затем запустить скрипт по изменению ссылок, поменять например "http://ya.ru" на "\helloworld.txt" и при следующем открытии меню "Изменение Гиперссылки" слева будет нажата другая кнопочка
В меню "Изменение Гиперссылки" слева есть возможность выбора:
Связать с:
- файлом, веб-страницей;
- местом в документе;
- новым документом;
- электронной почтой.
Ты не ошибся...
а по-моему все ссылки одинаковые. она становится гипер или обычной просто из-за содержимого ссылки. например если начинается на "http://..." значит гипер, а если "C:\..." или "\\192.168.1.1\..." значит локальная или сетевая там.
или я ошибаюсь?
как сделать чтобы менял обычные ссылки а не гипер ?
Вроде бы формат файла не изменился (xls) 97-2003, как был так и остался (не у всех, просматривающих, таблицу есть новый (xlsx))
Может быть ты раньше сохранял в формате 2007-2010 экселя (xlsx), а нынче в старый формат (xls)?
Да, действительно, в директорию Q:\Тендерный отдел\01_Процедуры\ и все сразу заработало!!!
От души благодарю!!! Единственное, почему файл весит в два раза больше теперь!!!?
Ну а название макроса зачем удалили?
Замените
на
и всё будет работать
Вот смотри, мой макрос тоже тот же но немного переделанный.
On Error Resume Next
Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
' part of hyperlink, which you want to change
oldString = "C:\Users\fss\AppData\Roaming\Microsoft\Excel\"
' to what to change
newString = "Q:\Тендерный отдел\01_Процедуры\"
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
Попробуй его, если не получится, закрой все книги Excel, скопируй нужный эксель файл в директорию Q:\Тендерный отдел\01_Процедуры\, затем запусти этот файл экселя оттуда, выполни этот скрипт, затем пересохрани (сохранить как...) в нужное место.
On Error Resume Next
Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
' part of hyperlink, which you want to change
oldString = "C:\Users\fss\AppData\Roaming\Microsoft\Excel\"
' to what to change
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
У тебя появилась данная проблема потому, что у тебя завис эксель, ты закрыл, эксель перезапустился, ты открыл автосохранение, чтобы не потерять работу, но при этом потерялись ссылки. Потому что ссылки были относительные.
Отпишешься.
Начну с начала.
Были Гиперссылки правильные стали не правильные.
По Гуглил, нашел макрос, все сделал как следует, но в результате - ругается.
Ват сам макрос:
On Error Resume Next
Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
oldString = "C:\Users\fss\AppData\Roaming\Microsoft\Excel\"
newString = "Q:\Тендерный отдел\01_Процедуры\"
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
что тебе конкретно надо? напиши свои потребности я отвечу. с тем материалом я давно разобрался так что думаю смогу тебе помочь.
Очень сильно обрадовался когда нашел данный материал. Спасибо!
Все сделал как написано, и .... результат: выскакивает окошко с текстом "compile error: expected: identifier"
Что делать, подскажите пожалуйста!!!
то есть ячейки сначала были пустые, затем я добавил сюда автозаполнением с первых двух гиперссылочных до 99, то меняются только первые 2 ячейки, которые я вбивал руками.
Скажите, а как мне создать ссылки, а затем их пронумеровать? то есть так:
а01.рсш
а02.рсш
...
а99.рсш
Потому что при этом раскладе у меня не конвертит:
Sub ZamenaIsporchennihGiperssilok()
On Error Resume Next
Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
' part of hyperlink, which you want to change
oldString = "rrr"
' to what to change
newString = "PIR 00"
i = 36
For Each sh In ActiveWorkbook.Worksheets ' ?????????? ??? ????? ? ???????? ?????
For Each hl In sh.Hyperlinks ' ?????????? ??? ??????????? ?? ?????
If hl.Address Like "*" & oldString & "*" Then
i = i + 1
st = newString + CStr(i)
hl.Address = Replace(hl.Address, oldString, st)
End If
Next
Next sh
End Sub
Спасибо, это как раз то, что мне было нужно.
Отправить комментарий