在创build文件后直接使用时，打破外部链接不工作

我有一个代码将两个工作表从一个工作簿复制到一个新的工作表。

由于这两个工作表包含图表，其中数据位于工作表本身上，但数据套指向不同的工作表，所以我只复制这些值，以避免外部链接。

不过，我发现还有一个外部链接到我原来的工作簿。

1. 我不知道它在哪里，因为没有公式了。
2. 我想到了名字，并删除了它们，因为有很多名字，甚至在原始文件中都没有。 这也没有帮助。
3. 当使用function区中的菜单时，我可以删除外部。

下面的代码也可以工作，当我在新的工作簿中使用它时打开它并在那里运行它。

Sub BreakLinks() Dim wb As Workbook Set wb = Application.ActiveWorkbook If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then For Each link In wb.LinkSources(xlExcelLinks) wb.BreakLink link, xlLinkTypeExcelLinks Next link End If End Sub 

但是，如果我想要将这些代码与复制一起使用，那么这并不能解决问题。 在断开链接之前，我故意保存了它，因为我认为它可能无法做到，但没有帮助。

有人知道为什么它不工作，或可以指向我的解决scheme？

以下是完整的代码：

 Sub ACTION_Export_Capex() Dim Pfad As String Dim Dateiname As String Dim ws As Worksheet Dim wb As Workbook Pfad = "D:\@Inbox\" Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx" 'Copy Sheets without formulas Sheets(Array("Capex_monthly", "Capex_YTD")).Copy For Each ws In Worksheets ws.UsedRange = ws.UsedRange.Value Next 'get rid of macrobuttons and hyperlinks For Each ws In Worksheets ws.Rectangles.Delete ws.Hyperlinks.Delete Next ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook 'delete external links If Not IsEmpty(ActiveWorkbook.LinkSources(xlExcelLinks)) Then For Each link In ActiveWorkbook.LinkSources(xlExcelLinks) ActiveWorkbook.BreakLink link, xlLinkTypeExcelLinks Next link End If ActiveWorkbook.Save ActiveWorkbook.Close 'go back to main menu in Cockpit Sheets("Menu").Select End Sub 

非常感谢。

编辑：最后brettdj得到的解决scheme，我只是不得不调整一下，让它在我的工作簿中完成。
代码如下：

 Sub ACTION_Export_Capex() Dim Pfad As String Dim Dateiname As String Dim ws As Worksheet Dim wb As Workbook Pfad = "D:\@Inbox\" Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx" 'Copy Sheets without formulas Sheets(Array("Capex_monthly", "Capex_YTD")).Copy For Each ws In Worksheets ws.UsedRange = ws.UsedRange.Value Next 'get rid of macrobuttons and hyperlinks For Each ws In Worksheets ws.Rectangles.Delete ws.Hyperlinks.Delete Next 'get rid of external link ActiveWorkbook.ChangeLink ThisWorkbook.Name, ActiveWorkbook.Name, xlLinkTypeExcelLinks ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close Sheets("Menu").Select End Sub 

Answer 1

如果我使用这个代码，当新的worbook再次打开的时候链接不见了。

我仍然困惑，为什么原始创作build立在即使删除两张复制的图纸时也存在的幻影链接中。

码

 Sub Test() Dim wb As Workbook Dim wb2 As Workbook Dim Pfad As String Dim Dateiname As String Dim ws As Worksheet With Application .ScreenUpdating = False .DisplayAlerts = falser End With Pfad = "D:\@Inbox\" 'Pfad = "c:\temp\" Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx" Set wb = ThisWorkbook Set wb2 = Workbooks.Add(1) wb.Sheets(Array("Capex_monthly", "Capex_YTD")).Copy After:=wb2.Sheets(1) wb2.Sheets(1).Delete wb2.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook wb2.ChangeLink wb.Name, wb2.Name, xlLinkTypeExcelLinks wb2.Close With Application .ScreenUpdating = True .DisplayAlerts = True .Goto wb.Sheets("Menu").[a1] End With Set wb2 = Workbooks.Open(Pfad & Dateiname) End Sub