AW: Vorgänger/Nachfolger Fenster per Tastatur
07.05.2009 16:08:27
fcs
Hallo Peter,
der Dialog mit den Zelladressen kann meines Wissens nicht per Tastaturkürzel angezeigt werden. Die Linie
ist mit einem Doppelklickereignis verküpft, das dann diesen Dialog mit den Zelladressen anzeigt.
Nachfolgendes Makro ermittelt alle Zelladressen der Nachfolger/Vorgänger der aktiven Zelle, wenn die entsprechende Anzeige aktiviert ist.
Dabei steuert das Makro nacheinander alle Adressen an (Bildschirm "flackert"!) und gibt alle Zellebereiche in einer Messagebox aus.
Den Code muss du in der persönlichen Arbeitsmappe in einem allgemeinen Modul einfügen. Dann das Makro "DetektivVorNach" einer Tastenkombination zuweisen.
Gruß
Franz
'Erstellt mit Excel 2003
Sub DetektivVorNach()
'Anzeige der vom Detektiv für aktive Zelle angezeigten Vörgänger/Nachfolger
MsgBox DetektivAnzeige(bolVorgaenger:=True) & vbLf _
& DetektivAnzeige(bolVorgaenger:=False)
End Sub
Function DetektivAnzeige(bolVorgaenger As Boolean) As String
' Ermittelt Vorgänger/Nachfolger der aktiven Zelle, wenn Detektiv entsprechend _
aktiviert
Dim Pfeilnummer As Long, Linknummer As Long, strMsg As String, strVor As String
Dim intFehler As Integer, rngZiel As Range
Dim rngQuelle As Range, strQuelleDatei As String
On Error GoTo Fehler
Set rngQuelle = ActiveCell
strQuelleDatei = ActiveWorkbook.Name
'Vorgänger- bzw. Nachfolger-Zellbereiche ermitteln
Do
Pfeilnummer = Pfeilnummer + 1
intFehler = 1
'1. Link des Pfeils
Set rngZiel = rngQuelle.NavigateArrow(TowardPrecedent:=bolVorgaenger, _
ArrowNumber:=Pfeilnummer)
If strQuelleDatei = ActiveWorkbook.Name _
And rngQuelle.Parent.Name = ActiveSheet.Name _
And ActiveCell.Address = rngQuelle.Address Then GoTo Fehler
strMsg = "'"
'bei externen Mappen Mappenname voranstellen
If ActiveWorkbook.Name strQuelleDatei Then
strMsg = strMsg & "[" & ActiveWorkbook.Name & "]"
End If
strVor = strVor & strMsg & ActiveSheet.Name & "'!" & rngZiel.Address & vbLf
' MsgBox "Nächster Bereich"
Linknummer = 1
'weitere Links des Pfeils
Do
Linknummer = Linknummer + 1
intFehler = 2
Set rngZiel = rngQuelle.NavigateArrow(TowardPrecedent:=bolVorgaenger, _
ArrowNumber:=Pfeilnummer, LinkNumber:=Linknummer)
strMsg = "'"
'bei externen Mappen Mappenname voranstellen
If ActiveWorkbook.Name strQuelleDatei Then
strMsg = strMsg & "[" & ActiveWorkbook.Name & "]"
End If
strVor = strVor & strMsg & ActiveSheet.Name & "'!" & rngZiel.Address & vbLf
' MsgBox "Nächster Bereich"
Loop
Resume02:
intFehler = 0
Loop
Fehler:
With Err
If .Number 0 Then
If .Number = 1004 Then
If intFehler = 1 Then
'do nothing, letzter Pfeil wurde bearbeitet
ElseIf intFehler = 2 Then
'letzte Adresse eines Pfeils wurde erreicht
Resume Resume02
End If
Else
MsgBox "Fehler: " & .Number & vbLf & .Description
End If
End If
End With
'Ergebnis aufbereiten
If strVor "" Then
DetektivAnzeige = IIf(bolVorgaenger = True, "Vorgängerzellen:", "Nachfolgerzellen:") _
& vbLf & vbLf & strVor
End If
End Function