Hi,
Basierend auf den vorangegangenen Vorschlägen ("Spur zum Nachfolger") habe ich versucht das ganze zu automatisieren.
Angefangen habe ich dabei mit der
Range.Dependents-Eigenschaft, welche ein Range-Objekt mit allen von der Quelle abhängigen Zellen zurückgibt. Haken dabei: Die Eigenschaft funktioniert nur für das aktive Blatt. Sind also Zellen anderer Tabellen der aktiven Mappe von der Quelle abhängig, werden diese nicht berücksichtigt.
Also mußte ein WorkAround her:
Dabei half mir die
Range.ShowDependents-Methode. Diese schafft es auch Abhängigkeiten in anderen Tabellen der aktiven Mappe mittels Pfeil anzuzeigen. (Diese Methode ist nichts anderes als der von Helmut (Saarbauer) aufgezeigte Weg ("Extras", "Formelüberwachung", "Spur zum Nachfolger").)
Da die bei dieser Methode entstehenden Pfeile in der Shapes-Auflistung auftauchen, lassen sie sich auch zählen. Im nachfolgenden Macro wird also beim Eintritt die Anzahl aller Shapes ausgelesen. Anschliessend werden "Nachfolger gesucht" um nun wieder die Anzahl der Shapes auszulesen. Sind nun Spurpfeile zu Nachfolgern vorhanden ist die Anzahl also größer als beim Eintritt in das Macro. Nun werden die Pfeile wieder entfernt, und der "Lösch"-Button deaktiviert...
Das Macro sieht dann bei mir hier aus wie folgt:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngShapes As Long, lngShapes2 As Long 'Variablendefinition
Dim rngZelle As Range 'Variablendefinition
Application.EnableEvents = False 'Events abschalten
Application.ScreenUpdating = False 'Schirmaktualisierung abschalten
lngShapes = ActiveSheet.Shapes.Count 'Anzahl Shapes zwischenspeichern
For Each rngZelle In Target 'alle Zellen in "Target" durchlaufen
With rngZelle
.ShowDependents 'evtl. vorhanden Spurpfeile zeichnen
lngShapes2 = ActiveSheet.Shapes.Count 'Anzahl Shapes erneut auslesen
If lngShapes < lngShapes2 Then 'wenn neue Shapes vorhanden-> Nachfolger vorhanden
.ShowDependents Remove:=True 'diese wieder löschen
CommandButton1.Enabled = False 'LöschButton deaktivieren
Application.EnableEvents = True 'Events einschalten
Application.ScreenUpdating = True 'Schirmaktualisierung wieder einschalten
Exit Sub 'und raus aus dem Macro
End If
End With
Next
'wenn keine Zelle in "Target" Nachfolger hat
CommandButton1.Enabled = True 'LöschButton aktivieren
Application.EnableEvents = True 'Events einschalten
Application.ScreenUpdating = True 'Schirmaktualisierung wieder einschalten
End Sub
Der dabei verwendete CommandButton1 ist eine direkt in Tabelle eingefügte "Befehlsschaltfläche" aus den ActiveX-Steuerelementen.
Bye
malSchauen
