У меня в большом файле произошел сбой гиперссылок. Я нашел макрос для замены пути в гиперсылки но при его применении он работает только для одной ячейки, а для диапазона ячеек не работает. Помогите пожалуйста как это можно исправить?
Макрос
Макрос
Код |
---|
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("Что меняем?", "Ввод данных", "AppData\Roaming\Microsoft\Excel") sRep = InputBox("На что меняем?", "Ввод данных", "Desktop\НКП и ПСП\Переписка") 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 |