Hi,
etwas lang, aber es funzt.
Gruß
Rolf
-
Legen Sie eine Sicherungskopie der Datei mit den externen
Verknuepfungen an, damit Sie notfalls auf die
Originalwerte und -formeln zurueckgreifen koennen.
-
Oeffnen Sie die Datei mit den externen Verknuepfungen,
die Sie loeschen moechten.
-
Druecken Sie Alt+F11, um den Visual Basic-Editor zu
starten.
-
Waehlen Sie EINFUEGEN-MODUL an, um das VBA-Projekt der
Datei um ein Modul zu erweitern und das zugehoerige
Codefenster zu oeffnen.
-
Geben Sie folgenden Programmcode in das Fenster ein:
Sub VerknuepfungenLoeschen()
Dim varLinks
Dim lngLinkCount As Long
Dim i As Long
Dim strLinkedFile As String
Dim lngChrPos As Long
Dim objRefName As Name
Dim strExtRef As String
Dim objWSh As Worksheet
Dim LinkRange As Range
Dim ar As Range
If MsgBox("Wollen Sie alle externen " & _
"Verknuepfungen loeschen und durch die " & _
„entsprechenden Werte ersetzen?“, vbYesNo) _
= vbYes Then
varLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If IsArray(varLinks) Then
lngLinkCount = UBound(varLinks)
For i = 1 To lngLinkCount
strLinkedFile = varLinks(i)
Do
lngChrPos = InStr(1, strLinkedFile, „“)
strLinkedFile = _
Right(strLinkedFile, _
Len(strLinkedFile) - lngChrPos)
Loop Until lngChrPos = 0
For Each objWSh In ActiveWorkbook.Worksheets
Set LinkRange = GetLinkRange(objWSh, _
strLinkedFile)
If Not LinkRange Is Nothing Then
For Each ar In LinkRange.Areas
ar.Value = ar.Value2
Next ar
End If
Next objWSh
Next i
End If
For Each objRefName In ActiveWorkbook.Names
If InStr(1, objRefName.RefersTo, „.xl“) > 0 Then
strExtRef = objRefName.Name
For Each objWSh In ActiveWorkbook.Worksheets
Set LinkRange = GetLinkRange(objWSh, strExtRef)
If Not LinkRange Is Nothing Then
For Each ar In LinkRange.Areas
ar.Value = ar.Value2
Next ar
End If
Next objWSh
objRefName.Delete
End If
Next objRefName
End If
End Sub
Function GetLinkRange _
(objSheet As Worksheet, _
strSearchFor As String) _
As Range
Dim TempCell As Range
Dim TempRange As Range
Dim strTempAdr As String
With objSheet.UsedRange
Set TempCell = _
.Find _
(What:=strSearchFor, _
LookIn:=xlFormulas, _
LookAt:=xlPart)
If Not TempCell Is Nothing Then
strTempAdr = TempCell.Address
Set TempRange = TempCell
Do
Set TempCell = .FindNext(TempCell)
If Not TempCell Is Nothing Then
Set TempRange = Application.Union(TempRange, _
TempCell)
End If
Loop While _
Not TempCell Is Nothing _
And TempCell.Address strTempAdr
End If
End With
Set GetLinkRange = TempRange
End Function
-
Verlassen Sie den Visual Basic-Editor per DATEI-
SCHLIESSEN UND ZURUECK ZU MICROSOFT EXCEL.
-
Druecken Sie Alt+F8, um das Dialogfeld mit den
verfuegbaren Makros zu oeffnen.
-
Doppelklicken Sie auf den Makronamen
„VerknuepfungenLoeschen“.
-
Beantworten Sie die Frage, ob die externen Verknuepfungen
geloescht werden sollen, mit JA.
Nach Abschluss der Prozedurausfuehrung sind alle Formeln und
Namen mit externen Verknuepfungen beseitigt. Wenn die
aktuelle Arbeitsmappe keine anderen Verknuepfungen enthaelt,
sehen Sie den Erfolg daran, dass der Befehl BEARBEITEN-
VERKNUEPFUNGEN nicht mehr anwaehlbar ist.
Der Makrocode laesst sich natuerlich noch komfortabler
gestalten - beispielsweise durch separate Abfragen bei jeder
einzelnen Verknuepfung. Um Ihnen die Anpassung der
Prozeduren zu erleichtern, stellen wir Ihnen deshalb die
Funktionsweise vor:
Der Code gliedert sich in die Hauptprozedur
„VerknuepfungenLoeschen“ und die Hilfsfunktion
„GetLinkRange“. Die Aufgabe der Hilfsfunktion besteht darin,
die Zellen zu ermitteln, in denen auf externe Dateien
verwiesen wird. Dazu uebergeben Sie das Tabellenblatt-
Objekt, in dem gesucht werden soll, und das Suchkriterium
als Funktionsparameter.
Die eigentliche Arbeit erledigt die Hauptprozedur. Darin
ermitteln Sie zunaechst die Datenquellen, die mit der
aktuellen Mappe verknuepft sind:
varLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
„LinkSources“ liefert ein Array mit den entsprechenden Pfad-
und Dateinamen. Dieses Array gehen Sie in einer For-Schleife
Element fuer Element durch. Dabei reduzieren Sie jeweils den
vollstaendigen Pfad auf den Dateinamen, den Sie dann als
Suchkriterium an die Hilfsfunktion „GetLinkRange“
uebergeben. Die Funktion liefert alle Zellen einer Tabelle,
in denen auf die externe Datei verwiesen wird. Mit der
Schleife
For Each ar In LinkRange.Areas
ar.Value = ar.Value2
Next ar
wandeln Sie die Formeln in die entsprechenden Werte um,
wobei die Zusammenfassung in Zellbereiche („Areas“) auch auf
Arrayformeln oder verbundene Zellen Ruecksicht nimmt.
Danach widmet sich die Prozedur den Namen in der
Arbeitsmappe:
For Each objRefName In ActiveWorkbook.Names
Falls sich ein Name auf eine andere Excel-Datei bezieht,
also falls im Bezug der Text „.xl“ auftritt …
If InStr(1, objRefName.RefersTo, „.xl“) > 0
… wird aehnlich wie zuvor per „GetLinkRange“ nach dem
Namen gesucht. Und ebenfalls wie zuvor werden die
Zellinhalte durch die entsprechenden Werte ersetzt.
Damit bezieht sich der Name aber weiterhin auf eine andere
Datei. Um auch diese versteckte Verknuepfung zu beseitigen,
muessen Sie schliesslich noch den Namen aus der Arbeitsmappe
loeschen:
objRefName.Delete
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]