У меня в большом файле произошел сбой гиперссылок. Я нашел макрос для замены пути в гиперсылки но при его применении он работает только для одной ячейки, а для диапазона ячеек не работает. Помогите пожалуйста как это можно исправить?
Макрос
Макрос
| Код |
|---|
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 |
