AW: externe Verknüpfungen
02.08.2010 10:46:51
bst
Morgen,
versuche es mal hiermit. Schreibt die Ergebnisse in das VBA-Direktfenster.
cu, Bernd
--
Option Explicit
Public Sub ListLinkSources()
Dim varList As Variant, varItem As Variant, strLinkName As String
varList = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(varList) Then
For Each varItem In varList
strLinkName = "[" & Mid(varItem, 1 + InStrRev(varItem, "\")) & "]"
SearchLinks strLinkName
Next
End If
End Sub
Private Sub SearchLinks(ByVal strLinkName As String)
Dim ws As Worksheet, rngFormulas As Range, rngCell As Range, n As Name, co As ChartObject, s _
As Series
Dim ch As Chart, pc As PivotCache
On Error GoTo ErrHandler
' Suchen in Tabellen
For Each ws In Worksheets
' Suchen in normalen Excel-Formeln
Set rngFormulas = getFormulaRange(ws)
If Not rngFormulas Is Nothing Then
For Each rngCell In rngFormulas
If InStr(1, rngCell.Formula, strLinkName, vbTextCompare) > 0 Then
LogIt strLinkName, "Range", ws.Name, rngCell.Address
End If
Next
End If
' Suchen in Diagrammen in Tabellen
For Each co In ws.ChartObjects
For Each s In co.Chart.SeriesCollection
If InStr(1, s.Formula, strLinkName, vbTextCompare) > 0 Then
LogIt strLinkName, "ChartObject", ws.Name, s.Formula
End If
Next
Next
Next
' Suchen in Namen
For Each n In ActiveWorkbook.Names
If InStr(1, n.RefersTo, strLinkName, vbTextCompare) > 0 Then
LogIt strLinkName, "Name", n.Name, n.RefersTo
End If
Next
' Suchen in Diagrammblättern
For Each ch In Charts
For Each s In ch.SeriesCollection
If InStr(1, s.Formula, strLinkName, vbTextCompare) > 0 Then
LogIt strLinkName, "Chart", ch.Name, s.Formula
End If
Next
Next
' Suchen in Pivotcaches
For Each pc In ActiveWorkbook.PivotCaches
If InStr(1, pc.SourceData, strLinkName, vbTextCompare) > 0 Then
LogIt strLinkName, "PivotCache", "-", pc.SourceData
End If
Next
Exit Sub
ErrHandler:
Debug.Print "Error: "; strLinkName; " "; Err.Number; " "; Err.Description
Resume Next
End Sub
Private Function getFormulaRange(ByVal ws As Worksheet) As Range
On Error Resume Next
Set getFormulaRange = ws.Cells.SpecialCells(xlCellTypeFormulas)
End Function
Private Sub LogIt(ByVal strLinkName$, ByVal strTyp$, ByVal strObjName$, ByVal strFormula$)
Debug.Print Format(strLinkName, "!" & String(20, "@")); _
Format(strTyp, "!" & String(20, "@")); _
Format(strObjName, "!" & String(20, "@")); _
strFormula
End Sub