AW: Nachfolger-Suche - NavigateArrow
28.01.2009 19:48:43
Erich
Hallo Jörg,
so ganz einfach ist deine Frage nicht zu beantworten.
Wenn du mal nach ArrowNumber excel googelst, findest du schon einige Lösungen, z. B.
http://www.online-excel.de/fom/fo_read.php?f=1&bzh=19001&h=18998
http://www.eggheadcafe.com/forumarchives/Excel/Jun2005/post23281259.asp
http://www.pro-soft.ch/pdf/Office_NEWS/E12072005.pdf
Da mir bislang keine davon gefallen hat, habe ich mir daraus eine weitere Version gebaut.
Vielleicht reicht dir das ja aus:
Option Explicit
Sub ZeigeNachfolger()
Dim wksA As Worksheet, iAn As Long, iLn As Long, jj As Long, rngN As Range
Dim strZ() As String, lngA As Long, strT As String, strA As String
ReDim strZ(1 To 4, 0 To 100)
strZ(1, 0) = "Blatt"
strZ(2, 0) = "Adresse"
strZ(3, 0) = "Formel"
strZ(4, 0) = "Arrow/Link"
Set wksA = ActiveSheet ' aktives Blatt
With ActiveCell ' aktive Zelle
strA = .Address(0, 0, , True)
.ShowDependents
iAn = 1
Do
iLn = iLn + 1
Set rngN = Nothing
On Error Resume Next
Set rngN = .NavigateArrow(TowardPrecedent:=False, _
ArrowNumber:=iAn, LinkNumber:=iLn)
On Error GoTo 0
If rngN Is Nothing Then ' kein Nachfolger
strT = strA
Else
strT = rngN.Address(0, 0, , True)
End If
If strT = strA Then ' kein Nachfolger
If iLn = 1 Then
Exit Do
Else
iAn = iAn + 1
iLn = 0
End If
Else
lngA = lngA + 1
If lngA > UBound(strZ) Then ReDim Preserve strZ(1 To 4, 0 To lngA + 100)
strZ(1, lngA) = iAn & " " & iLn & " " & rngN.Worksheet.Name
strZ(2, lngA) = rngN.Address(0, 0)
strZ(3, lngA) = "'" & rngN.FormulaLocal
strZ(4, lngA) = iAn & "_" & iLn
End If
Loop
End With
wksA.ClearArrows
ReDim Preserve strZ(1 To 4, 0 To lngA)
If lngA > 0 Then
Worksheets.Add before:=Sheets(1)
Cells(1, 1).Resize(lngA + 1, 4) = Application.Transpose(strZ)
Columns("A:C").AutoFit
Else
MsgBox "Nix gefunden"
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort