Question

我目前正试图将一些VBA写入用户表单，这将允许我将sheet1中的所有外部链接更改为workbookA，然后将sheet2中的所有外部链接更改为workbookB，然后将所有外部链接更改为sheet3中的workbookC等等等。

我已使用此代码执行工作簿中的所有链接

Private Sub btnUpdate_Click()

Dim Source As String

Application.ScreenUpdating = False
currentsource = ActiveWorkbook.LinkSources(xlExcelLinks)

    'This is just a record of the changing source files
     Sheets("Notes").Range("C2") = currentsource

    'txtDirectory is the new source location chosen in my userform 
     Sheets("Notes").Range("C3") = txtDirectory

Source = Sheets("Notes").Range("C2")

ActiveWorkbook.ChangeLink Name:=Source, NewName:=txtDirectory, Type:=xlExcelLinks

Application.ScreenUpdating = True

End Sub

这完美无缺，但我现在需要根据我所在的表单来调整它以改变链接。

我做了大量的谷歌搜索无济于事，我也花了很多时间在我的VBA书籍中。

非常感谢任何帮助。

Answer 1

下面的代码会将工作簿中每个链接的名称打印到即时窗口。从那里你应该能够根据工作表名称编写围绕哪些链接进行处理的逻辑。

Sub link()
Dim i As Integer
Dim x As Variant
x = ThisWorkbook.LinkSources(xlLinkTypeExcelLinks)
For i = 1 To UBound(x)
Debug.Print x(i)
Next i
End Sub

Answer 2

我使用类似的代码来做东西，你需要调整这段代码：

Dim Sh As Worksheet
with Thisworkbook
    For Each Sh In .Worksheets
        For q = 1 To Sh.Hyperlinks.Count
            h = Sh.Hyperlinks(q).Address
            If Left(h, Len(.Path)) <> Left(.Path, Len(.Path)) Then
                If InStr(1, h, "\OBJETS\") > 0 Then 'obtenir le nom du fichier sans chemin
                    h = Mid(h, InStrRev(h, "\OBJETS\", Len(h)) + 1, Len(h))
                ElseIf InStr(1, h, "\Règles\") > 0 Then 'obtenir le nom du fichier sans chemin
                    h = Mid(h, InStrRev(h, "\Règles\", Len(h)) + 1, Len(h))
                Else
                    h = Mid(h, InStrRev(h, "\", Len(h)) + 1, Len(h))
                End If
                Sh.Hyperlinks(q).Address = Replace(Replace(.Path, "\OBJETS", ""), "\Règles", "") & "\" & h
            End If
        Next q
    Next Sh
    Set Sh = Nothing
End With

使用VBA更改工作表内的源链接而不是工作簿

2 个答案: