Question

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

由于这两个工作表包含数据在工作表本身上的图形，但数据中心引用了不同的工作表，因此我只复制值，以避免外部链接。

但是我发现还有一个指向我原始工作簿的外部链接。

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

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

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

但是，如果我想将该代码与复制结合使用，则无法解决问题。在破坏链接之前我故意保存它，因为我认为它可能无法做到，但它没有帮助。

有人知道它为什么不起作用或者能指出我的解决方案吗？

这是完整的代码：

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得到了解决方案，我只需稍微调整它就可以在我的工作簿中完成它。
这是代码：

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再次打开时，链接就会消失。

我仍然感到困惑，为什么即使删除了两张复制的纸张，原始创作也会建立一个幻像链接。

码

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

在创建文件后直接使用时，断开外部链接不起作用

1 个答案: