Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
548to552
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Auffinden mit anderen Dateien verknüpfte Zellen

Auffinden mit anderen Dateien verknüpfte Zellen
20.01.2005 19:46:37
Bernhard
Hallo,
ich habe eine sehr große Excel-Datei, die offensichtlich Formeln enthält,
die sich auf andere Excel-Dateien beziehen.
Jedesmal, wenn ich die Datei öffne, fragt Excel mich, ob die Bezüge auf die verknüpfte(n) Datei(en) aktualisiert werden sollen.
Ich möchte die Verknüpfungen löschen und alle Formeln in einer Datei haben.
Wie kann ich herausfinden, welche Formeln mit anderen Dateien verknüpft sind?
Vielen Dank für Eure Hilfe.
Grüße,
Bernhard

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Link Finder - Externe Verknüpfungen aufspüren
Beate
Hallo Bernhard,
Links bzw. Verweise auf andere Excel-Dateien können sich an den unglaublichsten Stellen verstecken:
- in normalen Formeln
- in Namen
- in Diagrammen
- in eingebetten Objekten, in Abhängigkeit des Objektes dort an verschiedenen Stellen
- im VBA-Code (?)
- in versteckten Schaltflächen
Ein ziemlich guter Link Finder ist nachstehendes Makro, füge dafür den gesamten Code in ein Modul der Datei ein und lasse das Makro FindLinks laufen.
Gruß,
Beate
--------------------------------------
Option Explicit
Private iFound As Integer

Private Function CheckDelete(Where As String, What As String)
Dim iResp As Integer
iFound = iFound + 1
iResp = MsgBox("Found a link in " & Where & ":" & Chr(10) & What & Chr(10) & "Shall I delete it?", vbYesNoCancel, "Link Finder")
Select Case iResp
Case vbCancel
Application.StatusBar = False
End
Case vbYes
CheckDelete = True
Case vbNo
CheckDelete = False
End Select
End Function

Sub FindLinks()
Dim obj As Object, oSheet As Object, oSeries As Object
Dim iOLEfound As Integer, stMsg As String
Dim rCell As Range, rFirst As Range, rToDo As Range
Dim rDone As Range, rAll As Range, rArea As Range
Static LinkString As String
iFound = 0
If IsEmpty(ActiveWorkbook.LinkSources()) Then
MsgBox "There are no links from this workbook"
Exit Sub
End If
LinkString = InputBox("Name of file to which links refer?" & _
Chr(10) & "Do not include path if file is open", Default:=LinkString, _
Title:="Link Finder")
If LinkString = "" Then Exit Sub
Application.StatusBar = "Looking for links in workbook names"
' first look for names
For Each obj In ActiveWorkbook.Names
If InStr(obj.RefersTo, LinkString) > 0 Then
stMsg = ""
If obj.Visible = False Then stMsg = stMsg & "hidden "
If CheckDelete(stMsg & "name " & obj.Name, obj.RefersTo) Then obj.Delete
End If
Next obj
' now scan each sheet in turn
For Each oSheet In ActiveWorkbook.Sheets
Application.StatusBar = "Looking for links in sheet " & oSheet.Name
iOLEfound = 0
If TypeName(oSheet) "Module" Then
For Each obj In oSheet.DrawingObjects
' any drawing object could be linked to a macro
If InStr(obj.OnAction, LinkString) > 0 Then
If CheckDelete("OnAction of " & TypeName(obj) & " '" & obj.Name & "' in " & oSheet.Name, obj.OnAction) Then obj.OnAction = ""
End If
' some drawing objects have formula properties
Select Case TypeName(obj)
Case "TextBox", "Picture", "Button"
If InStr(obj.Formula, LinkString) > 0 Then
If CheckDelete("formula of " & TypeName(obj) & " '" & obj.Name & "' in " & oSheet.Name, obj.Formula) Then obj.Formula = ""
End If
Case "OLEObject"
' can't get to the formula of an OLEObject - so report at end
iOLEfound = iOLEfound + 1
Case "ChartObject"
For Each oSeries In obj.Chart.SeriesCollection
If InStr(oSeries.Formula, LinkString) > 0 Then
If CheckDelete("series " & oSeries.Name & " in Chart " & obj.Name & " on sheet " & oSheet.Name, oSeries.Formula) Then oSeries.Formula = ""
End If
Next oSeries
End Select
Next
If TypeName(oSheet) = "Worksheet" Then
' look in cell formulae
Application.ScreenUpdating = False ' otherwise screen flashes
Set rCell = Nothing
On Error Resume Next
Set rCell = oSheet.UsedRange.Find(LinkString, oSheet.UsedRange.Range("A1"), xlFormulas, xlPart, xlByRows, xlNext)
On Error GoTo 0
If Not rCell Is Nothing Then
Set rFirst = rCell
Set rAll = rCell
Do
Set rCell = oSheet.UsedRange.FindNext(rCell)
Set rAll = Union(rAll, rCell)
Loop Until rCell.Address = rFirst.Address
Application.ScreenUpdating = True
For Each rArea In rAll.Areas
Set rDone = rArea.Cells(1, 1)
Set rToDo = rArea.Cells(1, 1)
Do
For Each rCell In rArea.Cells
If Intersect(rDone, rCell) Is Nothing Then
If rToDo Is Nothing Then
Set rToDo = rCell
ElseIf rCell.FormulaR1C1 = rToDo.Cells(1, 1).FormulaR1C1 Then
Set rToDo = Union(rToDo, rCell)
End If
End If
Next rCell
stMsg = "cell "
If rToDo.Cells.Count > 1 Then stMsg = "cells "
If CheckDelete(stMsg & oSheet.Name & "!" & rToDo.Address, rToDo.Range("A1").Formula) Then
rToDo.Formula = rToDo.Value
End If
Set rDone = Union(rDone, rToDo)
Set rToDo = Nothing
Loop Until rDone.Address = rArea.Address
Next rArea
End If
ElseIf TypeName(oSheet) = "Chart" Then
' look in chart series
For Each oSeries In oSheet.SeriesCollection
If InStr(oSeries.Formula, LinkString) > 0 Then
If CheckDelete("series " & oSeries.Name & " in Chart " & _
obj.Name, oSeries.Formula) Then oSeries.Formula = ""
End If
Next oSeries
ElseIf TypeName(oSheet) = "DialogSheet" Then
' look in on action of dialog frame
If InStr(oSheet.DialogFrame.OnAction, LinkString) > 0 Then
If CheckDelete("dialog frame of " & oSheet.Name, oSheet.DialogFrame.OnAction) Then oSheet.DialogFrame.OnAction = ""
End If
End If
End If
If iOLEfound = 1 Then
MsgBox "There is an OLE Object on sheet " & oSheet.Name & " which I could not check"
oSheet.OLEObjects.Select
ElseIf iOLEfound > 1 Then
MsgBox "There are " & iOLEfound & " OLE Objects on sheet " & oSheet.Name & " which I could not check"
oSheet.OLEObjects.Select
End If
Next oSheet
If iFound = 0 Then MsgBox "No links found to " & LinkString, vbInformation, "Link Finder"
Application.StatusBar = False
End Sub
Anzeige
AW: Link Finder - Externe Verknüpfungen aufspüren
21.01.2005 15:25:28
Bernhard
Hallo Beate,
vielen Dank für das Macro, aber es läuft leider nicht:
"checkDelete" macht es blau und es kommt die Meldung:
Compile error: Sub or function not defined.
Was kann ich tun?
Gruß,
Bernhard
Externe Verknüpfungen im markierter Bereich
Beate
Hallo Bernhard,
also ich habe den Code bei mir schon mit Erfolg eingesetzt (er ist nicht von mir, ich weiß aber auch nicht, von wem ursprünglich) - ich arbeite mit Excel XP Pro. Vielleicht liegt es an der Version, dass es bei mir geht und bei dir nicht.
Alternativ kann ich dir Folgendes geben, es untersucht aber nur den markierten Bereich, also Blatt für Blatt abarbeiten, dabei werden externe Verknüpfungen farblich hinterlegt (Makro in ein Modul einfügen):

Sub ExterneLinksMarkieren()
Dim cell As Range, dst As Range
Set dst = Nothing
For Each cell In Selection
If Left(cell.Formula, 1) = "=" And InStr(cell.Formula, "[") > 1 Then
If dst Is Nothing Then
Set dst = cell
Else
Set dst = Union(dst, cell)
End If
End If
Next cell
If dst Is Nothing Then
MsgBox ("Keine externen Verknüpfungen vorhanden")
Else
dst.Select
End If
End Sub

Gruß,
Beate
Anzeige

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige