IT‎ > ‎Разработка ПО‎ > ‎

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

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
Comments