Das fktt aber nur bei echten HLs, ...
05.03.2015 02:42:24
Luc:-?
…Michael,
nicht bei indirekten Fml-HLs wie =HYPERLINK("…"[;"…"])!
Hallo, Philipp;
es geht nicht ohne VBA aber durchaus mit BedingtFormat-Unterstützung, welches die ZellFärbung unternimmt. Das hat den Vorteil, dass man diese nicht zurücksetzen muss und die Zelle somit ursprüngl jede beliebige Farbe haben kann. Anderenfalls müsste sich das Pgm diese merken.
Das folgd Pgm geht von einer BedingtFormatierg von HL-Zellen per Zellwert-Vgl mit einer benannten Variablen des Blattes aus. Dieser Name wird automatisch bei BlattAktivierung angelegt, falls er nicht schon vorhanden ist (ggf den Wert der ModulKonstanten ändern!). Also zuerst mal auf ein anderes Blatt wechseln, dann auf das Blatt mit den nachfolgden EreignisProzeduren zurückkehren.
Auf alle relevante HLs (auch Fml-HLs!) enthaltende Zellen, die einbezogen wdn sollen, ist dann eine auf den Zellwert bezogene BedingtFormatierung zu legen: Zellwert ist gleich und Fml =HLText (oder der geänderte Name), sowie ZellFarbe einstellen. Im DokumentKlassenModul des relevanten Blattes sind dann folgende EreignisProzeduren anzulegen:
Option Explicit
Const naHLTx$ = "HLText"
Rem Legt ggf f.HL-ZellFärb notwendigen Namen an.
Private Sub Worksheet_Activate()
On Error Resume Next
If IsError(Me.Names(naHLTx)) Then Me.Names.Add naHLTx, "="""""
End Sub
Rem Setzt den Namenswert auf Leer-String zurück.
Private Sub Worksheet_Deactivate()
On Error Resume Next
If IsError(Me.Names(naHLTx)) Then Else Me.Names(naHLTx).Value = "="""""
End Sub
Rem Färbt im ZusammSpiel m.BedingtFormat d.zuletzt angeklickten HL
' jegl Art; dabei bleibt letzte ZellFärb solange erhalt wie kein
' and HL (auch o.BedingtFormat!) angeklickt oder d.Blatt gewech-
' selt wurde; BedingtFormat f.HLZellen muss m.VglsBezug z.blatt-
' bezogen dafür vgebenen Namen (enthält jew ZWert) angelegt wdn.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const txFmHL$ = "HYPERLINK("
Dim adZiel$, Ziel As Hyperlink
On Error GoTo ex: If Target.Count > 1 Then Err.Raise xlErrNA
If CBool(Target.Hyperlinks.Count) Or (Target.HasFormula _
And CBool(InStr(Target.Formula, txFmHL))) Then
If CBool(Target.FormatConditions.Count) Then
Me.Names(naHLTx).Value = "=""" & Target & """"
If Target.Hyperlinks.Count = 0 Then
adZiel = Me.Evaluate(Replace(Target.Formula, _
",""" & Target & """", ""))
Set Ziel = Target.Hyperlinks.Add(Target, adZiel)
Ziel.Follow: Ziel.Delete
Target.Font.Underline = xlUnderlineStyleSingle
Else: Target.Hyperlinks(1).Follow
End If
Else: On Error Resume Next
If IsError(Me.Names(naHLTx)) Then
Else: Me.Names(naHLTx).Value = "="""""
End If
End If
End If
ex: Set Ziel = Nothing
End Sub
Viel Erfolg!
Gruß, Luc :-?
Besser informiert mit …