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 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

Answer 2

在您的超链接循环周围循环以遍历每张纸。

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

宏可遍历工作簿中的所有工作表

2 个答案: