Verknüpfung
19.04.2021 12:08:55
Mike
ich habe folgendes Problem bei dem ich verzweifle.
Ich exportiere aus meiner Quelldatei 2 Tabellenblätter.
Diese werden per VBA nur mit Werten gefüllt. (Alles überprüft, keine Formeln, Verknüpfungen, bedingte Formatierungen vorhanden).
Öffne ich jedoch die neue Datei, kommt immer die Meldung " einige Verknüpfungen lassen sich nicht aktualisieren".
Wenn ich danach schaue, verweist er auf die Quelldatei (Fehler, Arbeitsblatt nicht gefunden.)
Verknüpfung löschen geht nicht, es sind auch keine Feldnamen oder Formelbruchstücke aus der Quelldatei zu finden.
Selbst wenn ich versuche per VBA beim Export dies alles zu löschen, kein Erfolg.
Vorab schon mal danke.
Mike
Hier mal der Code:
Sub export()
Dim Pfad$
Dim Name As String
Dim wbkNeu As Workbook
Dim wbkAlt As Workbook
Call unprotect
Pfad = ThisWorkbook.Path 'Pfad der gerade geöffneten Datei
Name = Worksheets("configuration").Range("a1") & "_" & Format(Date, "yyyymmdd") & "21.1" & " _
.xlsx"
If Dir(ThisWorkbook.Path & "\kit calculation\", vbDirectory) = "" Then MkDir (ThisWorkbook. _
Path & "\kit calculation\")
Set wbkAlt = ActiveWorkbook
wbkAlt.Worksheets(Array("summary", "consolidate")).Copy 'Neue Datei erstellen und _
Tabellenblatt reinkopieren
Set wbkNeu = ActiveWorkbook 'Neue Datei der Variablen zuweisen
With wbkNeu.Worksheets("summary").UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
.Cells.FormatConditions.Delete 'bedingte formatierung löschen
End With
With wbkNeu.Worksheets("consolidate").UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
.Cells.FormatConditions.Delete
End With
'alle verknüpfungen löschen
Dim arrLinks As Variant, i As Integer
arrLinks = ActiveWorkbook.LinkSources(xlLinkTypeExcelLinks)
If Not IsEmpty(arrLinks) Then
For i = 1 To UBound(arrLinks)
ActiveWorkbook.BreakLink _
Name:=arrLinks(i), _
Type:=xlLinkTypeExcelLinks
Next
End If
Application.CutCopyMode = False
'Neue Datei speichern:
wbkNeu.SaveAs Filename:=Pfad & "\kit calculation\" & Name, FileFormat:=xlOpenXMLWorkbook
'Neue Datei schließen
wbkNeu.Close savechanges = True
Set wbkNeu = Nothing
Set wbkAlt = Nothing
End Sub
Anzeige