Verknüpfung zu Datei in Excel suchen

[Rabe]

Hi,

ich habe eine Datei mit >10 Tabellenblättern und vielen Pivots, PQ-Abfragen, usw. In der wird beim Öffnen auf eine früher verknüpfte Datei hingewiesen, weil es diese Datei nicht mehr gibt.
Bei "Datei" - "Verknüpfungen anzeigen" steht diese aber nicht drin.

Wie finde ich den Aufruf der Datei zum Anpassen oder Löschen?

[WillWissen]

Hi Ralf,

hast du noch Bereichsnamen, die auf eine Verknüpfung hinweisen können? Sonst schau doch mal hier https://support.office.com/de-de/article...fdb1442748, ob dir das weiterhilft.

[Gast 123]

Hallo Ralf

seit ewigen Zeiten benutze ich um Verknüpfungen aufzuspüren diesen Code von Hajo.  Formel Verknüpfungen findet der in jedem Blatt. Sollte es Verknüpfungen über Blatt Objekte geben, z.B. über Makros, kann du dir selbst eine Liste erstellen indem du alle Objekte über For Next auflistest mit:  Cells() = ActiveSheet.Shapes(x).OnAction  -  PS Statt Shapes benutze ich gern "DrawingObjects," weil Shapes manchmal nicht alle findet!  

mfg  Gast 123

Code:

Option Explicit       'Verknüpfung Hajo


Sub Verknuepfte_Zellen()
'**************************************************
'* H. Ziplies                                     *
'* 24.08.08                                       *
'* erstellt von HajoZiplies@web.de                *
'* http://Hajo-Excel.de/                          *
'**************************************************
   On Error GoTo Fehler1                           ' Fehlerbehandlung ausschalten
   Dim RaZelle As Range                            ' Variable für aktuelle Zelle
   Dim ByMldg As Byte                              ' Variable Meldung
   Dim WsSh As Worksheet                           ' Variable Tabelle
   Dim ObZelle As Object                           ' Variable für Namen
'GoTo weiter:
   For Each WsSh In Worksheets                     ' Schleife über alle Tabellen der Datei
       ' Prüfen ob Tabelle schon vorhanden
       If InStr(WsSh.Name, "Verknüpfung") > 0 Then
           ByMldg = MsgBox("Eine Tabelle mit dem Namen " _
               & "Verknüfungen ist schon vorhanden, sollen die " _
               & "Daten gelöscht werden", vbYesNo + vbQuestion, _
               "Löschabfrage ?", "", 0)
           If ByMldg = 6 Then              ' Ja wurde gedrückt
               ' Zellen komplett löschen,
               ' da schon bestimmte Formate eingestellt
               WsSh.Cells.Delete
               ' Kennzeichnen dass Tabelle schon vorhanden
               ByMldg = 45
               ' Schleife verlasse, da Tabelle gefunden
               Exit For
           Else
               Exit Sub
           End If
       End If
   Next WsSh
weiter:
   Application.ScreenUpdating = False              ' Bildschirmaktualisierung ausschalten
   Application.EnableEvents = False                ' Reaktion Eingabe abschalten
   If ByMldg <> 45 Then                            ' Tabelle anlegen falls noch nicht vorhanden
       ' Anlegen hinter der letzten Tabelle ubnd Namen geben
       Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Verknüpfung"
       With ActiveWindow
           .SplitRow = 2
           .FreezePanes = True
       End With
   End If
   With Worksheets("Verknüpfung")
       ' Überschriftszeilen
       ' Formel mit Ergebnis Fehler
       .Cells(1, 1) = "Formel mit Ergebnis Fehler"
       .Cells(2, 1) = "Zelle"
       .Cells(2, 2) = "Tabelle"
       .Cells(2, 3) = "Formel"
       ' Formel zu anderen Arbeitsmappe
       .Cells(1, 5) = "Formel zu anderen Arbeitsmappe"
       .Cells(2, 5) = "Zelle"
       .Cells(2, 6) = "Tabelle"
       .Cells(2, 7) = "Formel"
       ' Formel zu anderen Tabellen in dieser Arbeitsmappe
       .Cells(1, 9) = "andere Tabelle"
       .Cells(2, 9) = "Zelle"
       .Cells(2, 10) = "Tabelle"
       .Cells(2, 11) = "Formel"
       ' restliche Formel
       .Cells(1, 13) = "Rest"
       .Cells(2, 13) = "Zelle"
       .Cells(2, 14) = "Tabelle"
       .Cells(2, 15) = "Formel"
       ' definierte Namen in dieser Arbeitsmappe
       .Cells(1, 17) = "definierte Namen"
       .Cells(2, 17) = "Name"
       .Cells(2, 18) = "Zelle"
       .Cells(2, 19) = "Tabelle"
       Rows("1:2").Font.Bold = True
       For Each WsSh In Worksheets                 ' Schleife über alle Tabellen
           If WsSh.Name <> "Verknüpfung" Then
               ' Schutz aufheben falls vorhanden
               ' WsSh.Unprotect "Passwort"
               On Error Resume Next
               Set RaZelle = WsSh.UsedRange.SpecialCells(xlCellTypeFormulas)
               Set RaZelle = Nothing
               If Err.Number = 0 Then
                   On Error GoTo 0
                   ' Schleife über den benuzten Bereich mit Formel
                   For Each RaZelle In WsSh.UsedRange.SpecialCells(xlCellTypeFormulas)
                       ' Formeln mit Fehler
                       If IsError(RaZelle.Value) Then
                           .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) _
                               = RaZelle.Address(0, 0)
                           .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2) _
                               = CStr(WsSh.Name)
                           .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3) _
                               = "'" & RaZelle.FormulaLocal
                       ' Formel zu anderer Arbeitsmappe
                       ElseIf InStr(RaZelle.Formula, ":\") <> 0 Then
                           .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 1, 5) _
                               = RaZelle.Address(0, 0)
                           .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, 6) _
                               = CStr(WsSh.Name)
                           .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, 7) _
                               = "'" & RaZelle.FormulaLocal
                       ' Formel zu andere Tabelle
                       ElseIf InStr(RaZelle.Formula, "!") > 1 Then
                           .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row + 1, 9) _
                               = RaZelle.Address(0, 0)
                           .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 10) _
                               = CStr(WsSh.Name)
                           .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 11) _
                               = "'" & RaZelle.FormulaLocal
                        Else               ' restliche Formeln
                           .Cells(.Cells(.Rows.Count, 13).End(xlUp).Row + 1, 13) _
                               = RaZelle.Address(0, 0)
                           .Cells(.Cells(.Rows.Count, 13).End(xlUp).Row, 14) _
                               = CStr(WsSh.Name)
                           .Cells(.Cells(.Rows.Count, 13).End(xlUp).Row, 15) _
                               = "'" & RaZelle.FormulaLocal
                       End If
                   Next RaZelle
               End If
               On Error GoTo 0                     ' Fehlerbehandlung einschalten
           End If
           ' WsSh.Protect "Passwort"               ' Schutz wieder setzen
       Next WsSh
       ' Programmteil Namen auslesen
       ' Schleife über alle Namen der Datei
       For Each ObZelle In ActiveWorkbook.Names
           .Cells(.Cells(.Rows.Count, 17).End(xlUp).Row + 1, 17) _
               = ObZelle.Name
           With .Cells(.Cells(.Rows.Count, 17).End(xlUp).Row, 18)
               If InStr(ObZelle, "REF") <> 0 Then
                   .Value = Mid(ObZelle, InStr(ObZelle, "!") + 1)
                   .Font.Bold = True
                   .Font.ColorIndex = 3
               ElseIf InStr(ObZelle, "\") <> 0 Then
                   .Value = Mid(ObZelle, InStr(ObZelle, "!") + 1)
                   .Font.Bold = True
                   .Font.ColorIndex = 4
               Else
                   .Value = Mid(ObZelle, InStr(ObZelle, "!") + 1)
               End If
           End With
           If InStr(ObZelle.RefersTo, "!") > 0 Then
               .Cells(.Cells(.Rows.Count, 17).End(xlUp).Row, 19) _
                   = Application.WorksheetFunction.Substitute(Mid(ObZelle, _
                   2, InStr(ObZelle, "!") - 2), "'", "")
           Else
               .Cells(.Cells(.Rows.Count, 17).End(xlUp).Row, 19) _
                   = ObZelle.RefersTo
           End If
       Next
       .Range("B:C,F:G,J:K,N:O, R:S").EntireColumn.AutoFit
       ' Überschriftszeilen
       ' Formel mit Ergebnis Fehler
       .Cells(1, "A") = "Zellen mit Ergebnis Error"
       ' Formel zu anderen Arbeitsmappe
       .Cells(1, "E") = "Formeln zu anderen Arbeitsmappen"
       ' Formel zu anderen Tabellen in dieser Arbeitsmappe
       .Cells(1, "I") = "Formeln zu anderen Tabellen"
       ' restliche Formel
       .Cells(1, "M") = "restliche Formeln"
       ' definierte Namen in dieser Arbeitsmappe
       .Cells(1, "O") = "Namen in dieser Arbeitsmappe"
   End With
Fehler1:
   On Error GoTo 0                                 ' Fehlerbehandlung eimschalten
   If Err <> 0 Then MsgBox "Es ist ein Fehler aufgetreten!"
   Application.ScreenUpdating = True               ' Bildschirmaktualisierung einschalten
   Application.EnableEvents = True                 ' Reaktion Eingabe einschalten
End Sub

[Gast 123]

Nachtrag

zum Thema Bereichsnamen von Günter. Die sind im Manager nicht immer ersichtlich, besonders bei #REF Error!  Mit VBA kannst du alle auflisten.

mfg  Gast 123

[Rabe]

Hallo,

Bereichsnamen auf andere Mappen habe ich keine.

Das Makro werde ich mal testen.



Aaah, ich habe es gefunden: ich hatte in "DieseArbeitsmappe" die Datei versucht zu öffnen.