[Excel-VBA] bedingte Formatierungen in 'reale' Formatierungen übertragen

Gepostet am: Feb 23, 2013 11:19:49 AM

Das größte Problem von bedingten Formatierungen ist, dass sie nicht kopierbar sind. Wie man diesem Problem entgegenwirken kann, möchte ich im Rahmen dieses Blogeintrags erörtern. 

Ausgangsbasis ist ein Tabellenblatt mit einer bedingten Formatierung. (sowohl die Tabelle als auch die Formatierung wurden bewusst einfach gehalten)

Schauen wir uns vorerst mal die Standardfunktionen von Excel dazu an bzw. wie sich Excel so verhält. Wenn man am selben Tabellenblatt bleibt und den Inhalt der Zwischenablage horizontal bzw. vertikal korrekt ausrichtet, dann scheinen auch die bedingten Formatierungen zu funktionieren. Leider nur auf den ersten Eindruck. Nur die vertikal kopierte bedingte Formatierung (blau) funktioniert korrekt. Die horizontal kopierte bedingte Formatierung (orange) bezieht sich weiter auf die Ausgangstabelle und funktioniert daher nicht korrekt. 

Soweit kann man damit mal nichts anfangen. Schauen wir mal weiter. Es gibt auch beim Kopieren keine spezielle Kopierfunktion, die die bedingten Formatierungen erhält, mal abgesehen von den Grafik bzw. verlinkte Grafik. Damit kann man aber nicht weiterarbeiten. Das geht also auch nicht. 

Also zurück zum Anfang - Es gibt verschiedene Arten von bedingten Formatierungen in Excel (FC.Type = XlFormatConditionType) und innerhalb des Types "xlCellValue" gibt es noch unterschiedliche XlFormatConditionOperator. Schauen wir uns mal den Type "xlCellValue" an und versuchen hiermit zu arbeiten. 

Sofern man nur Zahlen als Vergleichswerte verwendet, dann kann man die Hintergrundfarbe beispielsweise folgendermaßen auslesen. 

Textfeld

Function ConditionalFormatingBackground(myRange As Range, indexCF As Integer) As Long     Dim FC As FormatCondition     Set FC = myRange.FormatConditions(indexCF)     If FC.Type = 1 Then         Select Case FC.Operator         Case 1             'Between. Can be used only if two formulas are provided.             If (Application.Evaluate(myRange.Value & Replace(FC.Formula1, "=", ">=")) = True) And _                 (Application.Evaluate(myRange.Value & Replace(FC.Formula2, "=", "<=")) = True) Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case 2             'Not between. Can be used only if two formulas are provided.             If (Application.Evaluate(myRange.Value & Replace(FC.Formula1, "=", ">=")) = True) And _                 (Application.Evaluate(myRange.Value & Replace(FC.Formula2, "=", "<=")) = True) Then                 ConditionalFormatingMatch = 0             Else                 ConditionalFormatingMatch = (FC.Interior.Color)             End If         Case 3             'Equal.             If Application.Evaluate(myRange.Value & FC.Formula1) = True Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case 4             'Not equal.             If Application.Evaluate(myRange.Value & FC.Formula1) = False Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case 5             'Greater than.             If Application.Evaluate(myRange.Value & Replace(FC.Formula1, "=", ">")) = True Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case 6             'Less than.             If Application.Evaluate(myRange.Value & Replace(FC.Formula1, "=", "<")) = True Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case 7             'Greater than or equal to.             If Application.Evaluate(myRange.Value & Replace(FC.Formula1, "=", ">=")) = True Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case 8             'Less than or equal to.             If Application.Evaluate(myRange.Value & Replace(FC.Formula1, "=", "<=")) = True Then                 ConditionalFormatingMatch = (FC.Interior.Color)             Else                 ConditionalFormatingMatch = 0             End If         Case Else             ConditionalFormatingMatch = 0         End Select     Else         Debug.Print "kann nicht ermittelt werden, da nicht vom Typ = xlCellValue"         ConditionalFormatingMatch = 0     End IfEnd Function

Das funktioniert mal schon gar nicht so schlecht:

Das deckt aber nur einen sehr geringen Teil der bedingten Formatierungen ab. Wie sieht es mit Verweisen auf andere Zellen aus? Geht nicht.

Man könnte also hergehen und auch versuchen diese Konstellation abzubilden. Aber das geht dann sehr weit. In meinen Augen ist für diesen Fall besser die Formatierung der Zellen anzuprogrammieren (Worksheet_Change)

Zellen überwachen

Private Sub Worksheet_Change(ByVal Target As Range)    If Target.Address = "$A$1" Then       meinMakro    End IfEnd Sub