Question

我试图遍历工作簿中的某些工作表以更新A列中的超链接，但我不断遇到我无法理解的各种问题。

Private Sub Workbook_Open()

    Dim HL As Hyperlink
    Dim lnk As String 'actual link
    Dim ori As String 'old link
    Dim nvr As String
    Dim forn As String 'hyperlink name
    Dim ws As Worksheet

    nvr = ThisWorkbook.Path 'new path
    ori = Sheets("check list e parametri").Range("a28").Value 'old path

    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Fatture consegnate 2019", "Progress", "check list e parametri", "Fatture consegnate backup" 'sheets to skip
            Case Else
                With ActiveWorksheet
                .Range("a2:a200").Select
                    For Each HL In Selection.Hyperlinks
                        forn = HL.TextToDisplay
                        lnk = HL.Address 'complete link
                        lnk = Replace(lnk, ori, nvr) 'replace old path with new path
                        ActiveSheet.Hyperlinks.Add Anchor:=HL.Range, Address:=lnk, TextToDisplay:=forn 'new hyperlink with name
                    Next HL
                End With
            End Select
    Next ws

    Sheets("check list e parametri").Range("a28") = nvr 'new path saved for the future

End Sub

我是VBA的新手，所以我的知识有限，我的代码至少..粗鲁。我尝试了各种循环方法，但是代码继续给我错误。我希望每次打开工作簿时，代码都会循环遍历所有未排除的工作表，标识所选范围内的超链接，用新路径替换旧路径，并保持相同的显示名称。（我正在使用Excel 2013）

Answer 1

现在可以使用了！感谢所有向我指出正确方向的人！代码如下：

Private Sub Workbook_Open()

Dim HL As Hyperlink
Dim lnk As String 'link attuale
Dim ori As String 'root vecchia
Dim nvr As String
Dim forn As String 'nome fornitore
Dim ws As Worksheet
Dim rng As Range

nvr = ThisWorkbook.Path 'nuova root
ori = Sheets("check list e parametri").Range("a28").Value 'vecchia root

For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
        Case "Fatture consegnate 2019", "Progress", "check list e parametri", "Fatture consegnate backup"
        'salta questi fogli
        Case Else
            Set rng = ws.Range("a2:a200")
                For Each HL In rng.Hyperlinks 'check link
                    forn = HL.TextToDisplay
                    lnk = HL.Address 'link completo
                    lnk = Replace(lnk, ori, nvr)
                    ws.Hyperlinks.Add Anchor:=HL.Range, Address:=lnk, TextToDisplay:=forn 'nuovo hyperlink
                Next HL
    End Select
Next ws

Sheets("check list e parametri").Range("a28") = nvr 'sostituisce vecchia root con nuova


End Sub

再次感谢您的帮助！

工作表循环问题

1 个答案: