Макрос для циклического прохождения всех рабочих листов в рабочей книге

Question

У меня есть задача сделать замену гиперссылок в 1000 файлов на новый сервер.У меня уже есть рабочий скрипт для замены гиперссылок, но он работает только на активной странице.Подскажите, как заставить его пройтись по всем страницам книги.

Sub changeLinks()

Const oldPrefix = "\\oldServer\common"
Const newPrefix = "\\NewServer\common"
Dim h As Hyperlink, oldLink As String, newLink As String

For Each h In ActiveSheet.Hyperlinks
    'this will change Address but not TextToDisplay
    oldLink = h.Address
    Debug.Print "Found link: " & oldLink
    If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
            newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))


            h.Address = newLink
            Debug.Print "  Changed to " & h.Address
    End If
Next h

End Sub

Answer 1

Создайте цикл вокруг гиперссылки, чтобы перебрать каждый лист.

Sub changeLinks()
    Dim objSheet As Worksheet

    Const oldPrefix = "\\oldServer\common"
    Const newPrefix = "\\NewServer\common"
    Dim h As Hyperlink, oldLink As String, newLink As String

    For Each objSheet In ThisWorkbook.Sheets
        For Each h In objSheet.Hyperlinks
            'this will change Address but not TextToDisplay
            oldLink = h.Address

            Debug.Print "Found link: " & oldLink

            If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
                newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))
                h.Address = newLink
                Debug.Print "  Changed to " & h.Address
            End If
        Next h
    Next
End Sub

Answer 2

Вызовите вашу процедуру в петле :

Sub ProcessAllSheets()
    Dim s As Worksheet
    For Each s In Sheets
        Call changeLinks(s.Name)
    Next s
End Sub

С этими изменениями в вашей программе:

Sub changeLinks(s As String)

Const oldPrefix = "\\oldServer\common"
Const newPrefix = "\\NewServer\common"
Dim h As Hyperlink, oldLink As String, newLink As String

For Each h In Sheets(s).Hyperlinks
    'this will change Address but not TextToDisplay
    oldLink = h.Address
    Debug.Print "Found link: " & oldLink
    If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
            newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))


            h.Address = newLink
            Debug.Print "  Changed to " & h.Address
    End If
Next h
End Sub