Userform und Auditpfeile
21.05.2009 21:58:57
P.Mackes
ich habe mir eine Userform gebaut, die von der aktiven Zelle alle Precedents und Dependents anzeigt und auch zu diesen springen kann.
Der relevante Code für die Listbox und Dependenprozedur sehen wie folgt aus:
Private Sub TraceDependents()
Application.ScreenUpdating = False
On Error Resume Next
Dim iAddressA As String
Dim UniqueValuesA As New Collection
Dim iArrowA As Integer, iLinkA As Integer
Dim CellA As String, Sheeta As String, WorkbookA As String
Set OriginA = ActiveCell
OriginA.ShowDependents
For iArrowA = 1 To 200
For iLinkA = 1 To 200
Err = 0
Set oDepeA = OriginA.NavigateArrow(False, iArrowA, iLinkA)
CellA = oDepeA.Address
Sheeta = oDepeA.Parent.Name
WorkbookA = oDepeA.Parent.Parent.Name
iAddressA = "[" & WorkbookA & "]" & Sheeta & "!" & CellA
UniqueValuesA.Add iAddressA, CStr(iAddressA)
If Err 0 Then Exit For
Next
Next
Me.lbTrace.RowSource = ""
For Each Item In UniqueValuesA
Me.lbTrace.AddItem Item, 0
Next Item
Me.lbTrace.ListIndex = 0
Application.ScreenUpdating = True
End Sub
Private Sub lbTrace_Click()
Dim iSeg1 As Integer, iSeg2 As Integer
Dim iCell As String, iSheet As String, iWorkbook As String
Item = lbTrace.Value
iSeg1 = Application.WorksheetFunction.Find("]", Item)
For i = 1 To Len(Item)
iWorkbook = Mid(Item, 2, iSeg1 - 2)
Next i
iSeg2 = Application.WorksheetFunction.Find("!", Item)
For i = 1 To Len(Item)
iCell = Mid(Item, iSeg2 + 1, i)
Next i
For i = 1 To Len(Item)
iSheet = Mid(Item, Len(iWorkbook) + 3, Len(Item) - Len(iWorkbook) - Len(iCell) - 3)
Next i
Workbooks(iWorkbook).Activate
Worksheets(iSheet).Select
Range(iCell).Select
End Sub
Der Code funktoniert so auch einwandfrei.
Jetzt habe ich folgendes Problem. In der Listbox werden mit dem Code immer Workbookname, Sheetname und Zelle angezeigt. Eigentlich soll der Workbookname aber nur dann angegeben werden, wenn der Link auch tatsächlich zu einem anderen Workbook geht. Befindet er sich im selben Workbook, reicht die Angabe Sheet+Zelle aus.
Ich habe schon echt eine Menge versucht den Code umzubauen, aber bin irgendwo in einer Sackgasse, wo ich nicht mehr weiß wie ich das hinkriege.
Ich weiß, dass es eine Menge Code ist, aber vielleicht fällt ja jemandem durch gezieltes Hinschauen eine Lösung ein.
Sofern das eher hilft, kann ich bei Bedarf auch ein Workbook mit dem gesamten Code uppen.
Gruß, Peter