OK! Nachtrag: Falls es sich mal tatsächl ...
21.04.2013 14:30:07
Luc:-?
…um Texte handeln sollte, Björn & Interessenten,
die, warum auch immer, per Farbskala bedingt formatiert wdn sollen, kann das ebenfalls realisiert wdn, indem ein Referenzbereich mit Zahlen passender Relation angelegt wird. Der muss dann im Prinzip nicht einmal formatiert wdn, kann also auch als benannte Matrixkonstante definiert wdn, (der/)die dann einem Pgm (ggf auch UDF) zur Ermittlung der Werterelationen und damit letztlich der Farbwerte übergeben wird. Über den TexteBereich wird dann eine simple Bedingtformatierung gelegt (idR vom „klassischen“ Typ1 → Menüpkt2), die normalerweise erfüllt ist (wenn bspw bestimmte Texte eingetragen wurden). Gegen die Farbwerte aus der Relationsberechnung der Referenzzahlen wird dann die Farbe des BedingtFormats des TexteBereichs per VBA-(Ereignis-)Prozedur getauscht, d.h., die ggf für den gesamten TexteBereich gültige BedingtFormatierung wird auf seine Zellen vereinzelt. Das ist ein bisschen knifflig, weil man nicht einfach den Geltungsbereich ändern kann ohne die Formatierung der anderen Zellen zu verlieren. Deshalb muss pro FolgeZelle das gleiche simple BedingtFormat mit geänderter Farbe hinzugefügt und erst zum Schluss das BedingtFormat der 1.Zelle nur auf diese beschränkt wdn.
Mit den Farbwerten kann dann je nach Vorgabe nicht nur die Zellfarbe des BedingtFormats des TexteBereichs, sondern auch wahlweise Muster-, Text- u/o Rahmenfarbe geändert wdn. Dafür nachfolgend ein Bsp auf Basis einer Ereignisprozedur…
Rem Übernimmt BedingtFormatFarben eines Referenzbereichs (speziell aus Farbskala)
' auf BedingtFormat-(Zell-, Muster- bzw Text-)Farben des Zielbereichs (Target -
' vorzugsweise m.Textinhalt); dabei muss b.Einsatz eigener Berechnungen anstatt
' d.UDF GetFConForm d.Referenzbereich nicht zwingend bedingt formatiert werden,
' da es nur auf d.Relation seiner Werte zu d.Eckwerten für d.GrdFarben ankommt.
' Achtung! Konstanten anpass u.GetFConForm ersetz (anteilige RGB-PotenzSummen)!
' Für weitgehende Automatik ist Umstellung auf Worksheet_Calculation erforderl!
' Vs1.0 -LSr -cd:20130421 -1pub:20130421herber -lupd:20130421t
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const FTyp As Integer = 1, inZBedNr As Integer = 1, QBedNr As Integer = 1, _
adQBez$ = "E119:E125", adZBez$ = "G119:G125" 'Anm: --> ersetzen!
Dim tcix As Long, trix As Long, ZBedNr As Long, FWerte As Variant, _
QBez As Range, ZBez As Range, Ziel As Range, fcBer As FormatCondition
On Error Resume Next
Set ZBez = Me.Range(adZBez)
If Not Intersect(Target(1), ZBez(1)) Is Nothing And Target.Count = ZBez.Count Then
Set QBez = Me.Range(adQBez): ZBedNr = inZBedNr
FWerte = GetFConForm(QBez, QBedNr) 'Anm: --> ersetzen!
For trix = 1 To Target.Rows.Count
For tcix = 1 To Target.Columns.Count
Set Ziel = Target(trix, tcix): Set fcBer = Ziel.FormatConditions(ZBedNr)
If trix > 1 Or tcix > 1 Then
With fcBer 'Anm: f.Type=1 --> ggf korr!
Ziel.FormatConditions.Add .Type, .Operator, .Formula1, .Formula2
End With
Set fcBer = Ziel.FormatConditions(ZBedNr + 1)
fcBer.ModifyAppliesToRange Ziel
End If
With fcBer
.StopIfTrue = False 'Anm: nur bei Bedarf!
Select Case FTyp
Case 1: .Interior.Color = FWerte(trix - 1, tcix - 1)
Case 2: .Interior.PatternColor = FWerte(trix - 1, tcix - 1)
Case 3: .Font.Color = FWerte(trix - 1, tcix - 1)
Case 4: .Borders.Color = FWerte(trix - 1, tcix - 1)
Case Else: GoTo ex
End Select
End With
Next tcix
Next trix
Target(1).FormatConditions(inZBedNr).ModifyAppliesToRange Target(1)
End If
ex: Set QBez = Nothing: Set ZBez = Nothing: Set fcBer = Nothing: Set Ziel = Nothing
End Sub
Wenn hier die Konstante FTyp=3 gesetzt wird, könnte man auch folgd Ergebnis erhalten:
Auf ähnliche Weise (nur unkomplizierter) kann man übrigens auch die Farben von BedingtFormaten vor Xl12 austauschen und so dynamisch (scheinbar) beliebig viele Bedingtformate pro Zelle simulieren.
Gruß + schöSo, Luc :-?
