Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

break external links not working when used directly after creating a file

Tags:

excel

vba

I have a code that copies two worksheets from one workbook to a new one.

Since those two worksheets contain graphs where the data is on the sheet itself, but the datacells refer to a different worksheet, I copy the values only, to avoid external links.

However I found out that there is still an external link to my original workbook.

  1. I don't know where it is though, since there are no formulas anymore.
  2. I thought about names and deleted them as well, since there were a lot of names, that didn't even exist in the original file. That didn't help either.
  3. I can delete the external, when using the menu in the ribbon.

And the code below also works, when I use it in the new workbook itself when opening it and running it in there.

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

However, if I want to use that code in conjunction with the copying, it does not do the trick. I saved it on purpose before breaking the link, because I thought it might not be able to do it, but it didn't help.

Does anybody know why it doesn't work or can point me to a solution?

Here's the complete code:

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

Thanks a lot in advance.

EDIT: In the end brettdj got the solution, I just had to tweak it a bit to get it done in my workbook.
Here's the code:

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
like image 481
bbear Avatar asked Feb 18 '16 11:02

bbear


1 Answers

If I use this code the links are gone when the new worbook is opened again.

I am still puzzled why the original creation builds in a phantom link that exists even when the two copied sheets are deleted.

code

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
like image 91
brettdj Avatar answered Sep 23 '22 05:09

brettdj