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

我正在试图写一些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 

这完美的作品，但我现在需要适应它来改变链接取决于我所在的工作表。

我做了很多的search工作，但也花了我很多时间在我的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