AW: Verknüpfungen analysieren ?
21.09.2006 15:51:20
Basch
Hallo Stefan, lass mal dies Makro durchlaufen. Es listet Dir alle Verknüpfungen auf.
Gruß, Bastian
Option Explicit
Sub Verknüpfte_Zellen()
'* H. Ziplies *
'* 22.08.03, 24.04.04; 31.07.05; 18.10.05 *
'* erstellt von Hajo.Ziplies@web.de *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
' Verknüpfungen auflisten
Dim RaZelle As Range
Dim ByMldg As Byte
Dim Sh As Worksheet
Dim ObZelle As Object
For Each Sh In Worksheets
If InStr(Sh.Name, "Verknüpfungen") > 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
Sh.Cells.Delete
ByMldg = 45
Exit For
Else
Exit Sub
End If
End If
Next Sh
If ByMldg <> 45 Then
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Verknüpfungen"
End If
With Worksheets("Verknüpfungen")
' Verknpüfungen
.Cells(1, 1) = "Zelle"
.Cells(1, 2) = "Tabelle"
.Cells(1, 3) = "Formel"
For Each Sh In Worksheets
If Sh.Name <> "Verknüpfungen" Then
' Sh.Unprotect ' .unprotect "Passwort"
For Each RaZelle In Sh.UsedRange
If RaZelle.HasFormula And InStr(RaZelle.Formula, ":\") > 1 Then
.Cells(.Range("A65536").End(xlUp).Row + 1, 1) = RaZelle.Address(0, 0)
.Cells(.Range("A65536").End(xlUp).Row, 2) = Sh.Name
.Cells(.Range("A65536").End(xlUp).Row, 3) = "'" & RaZelle.Formula
End If
Next RaZelle
' Sh.Protect ' .Protect "Passwort"
End If
Next Sh
' Namen
.Cells(1, 5) = "Name"
.Cells(1, 6) = "Bezug"
For Each ObZelle In ActiveWorkbook.Names
.Cells(.Range("E65536").End(xlUp).Row + 1, 5) = ObZelle.Name
With .Cells(.Range("E65536").End(xlUp).Row, 6)
If InStr(ObZelle, "REF") <> 0 Then
.Value = ObZelle '"Fehlerhaft"
.Font.Bold = True
.Font.ColorIndex = 3
ElseIf InStr(ObZelle, "\") <> 0 Then
.Value = ObZelle
.Font.Bold = True
.Font.ColorIndex = 4
Else
.Value = Mid(ObZelle, 2)
End If
End With
Next
End With
End Sub