Bedingte Formatierung per VBA
Jörg
Hoffe in diesem Forum Infos zu bekommen um folgendes Prob lösen zu können.
Es geht um das Erstellen von Bedingten Formaten per VBA.
Auf einem leeren Testblatt funtioniert das Modul einwandfrei. Sobald ich aber einen
benutzten Bereich festlege (z.B. A1:G88) und diesen mit Testdaten fülle schmiert
mir das Modul (Index ausserhalb des gültigen Bereichs) nach der 2. Formatierung ab.
Ändere ich den Anwendungsbereich aller 6 Formatierungen ab und beginne immer
in der Zelle A1 funktioniert das ganze wieder aber eben mit Bereichen die mir nichts nutzen.
Da ich unter Excel 2007 arbeite kann die max. 3 Bedingungen Regel nich das Hindernis sein.
Hat jemand von euch einen Hinweis oder Tipp.
Vielen Dank schonmal im vorraus für die Mühe
Gruß Jörg
Sub BedingteFormateErstellen()
Dim countFormat As Byte
Dim countColumn As Byte
Dim lastRow As Byte
lastrow = Cells(65536, 1).End(xlup).Row
countColumn = ActiveSheet.Cells(1, 255).End(xlToLeft).Column
== Löschen vorhandenen Bedingten Formatierungen
If Cells.FormatConditions.Count >= 1 Then
Cells.FormatConditions.Delete
End If
== 1.Bedingung -
countFormat = countFormat + 1
Cells(1, 1).Activate
With Range(Cells(1, 1), Cells(lastRow, countColumn))
.FormatConditions.Add xlExpression, Formula1:="=$A1"""""
With .FormatConditions(countFormat)
.Priority = (countFormat)
.StopIfTrue = False
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End With
== 2.Bedingung -
countFormat = countFormat + 1
Cells(1, 1).Activate
With Range(Cells(1, 1), Cells(lastRow, 1))
.FormatConditions.Add xlExpression, Formula1:="=$A1"""""
With .FormatConditions(countFormat)
.Priority = (countFormat)
.StopIfTrue = False
.Interior.Pattern = xlPatternRectangularGradient
.Interior.Gradient.RectangleLeft = 0.5
.Interior.Gradient.RectangleRight = 0.5
.Interior.Gradient.RectangleTop = 0.5
.Interior.Gradient.RectangleBottom = 0.5
With .Interior.Gradient.ColorStops
.Clear
With .Add(0)
.ThemeColor = xlThemeColorDark1
End With
With .Add(1)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
End With
End With
End With
End With
== 3.Bedingung -
countFormat = countFormat + 1
Cells(1, 2).Activate
With Range(Cells(1, 2), Cells(lastRow, countColumn))
.FormatConditions.Add xlExpression, Formula1:="=BlaBlaBla"
With .FormatConditions(countFormat)
.Priority = (countFormat)
.StopIfTrue = False
.Interior.Pattern = xlPatternRectangularGradient
.Interior.Gradient.RectangleLeft = 0.5
.Interior.Gradient.RectangleRight = 0.5
.Interior.Gradient.RectangleTop = 0.5
.Interior.Gradient.RectangleBottom = 0.5
With .Interior.Gradient.ColorStops
.Clear
With .Add(0)
.Color = 13434879
End With
With .Add(1)
.Color = 13311
End With
End With
End With
End With
== 4.Bedingung -
countFormat = countFormat + 1
Cells(1, 2).Activate
With Range(Cells(1, 2), Cells(lastRow, countColumn))
.FormatConditions.Add xlExpression, Formula1:="=BlaBlaBla"
With .FormatConditions(countFormat)
.Priority = (countFormat)
.StopIfTrue = False
.Interior.Pattern = xlPatternRectangularGradient
.Interior.Gradient.RectangleLeft = 0.5
.Interior.Gradient.RectangleRight = 0.5
.Interior.Gradient.RectangleTop = 0.5
.Interior.Gradient.RectangleBottom = 0.5
With .Interior.Gradient.ColorStops
.Clear
With .Add(0)
.Color = 13434879
End With
With .Add(1)
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.400006103701895
End With
End With
End With
End With
== Festlegen der 5.Bedingung -
countFormat = countFormat + 1
Cells(4, 2).Activate
With Range(Cells(4, 2), Cells(lastRow, countColumn))
.FormatConditions.Add xlExpression, Formula1:="=BlaBlaBla"
With .FormatConditions(countFormat)
.Priority = (countFormat)
.StopIfTrue = False
.Interior.Pattern = xlPatternRectangularGradient
.Interior.Gradient.RectangleLeft = 0.5
.Interior.Gradient.RectangleRight = 0.5
.Interior.Gradient.RectangleTop = 0.5
.Interior.Gradient.RectangleBottom = 0.5
With .Interior.Gradient.ColorStops
.Clear
With .Add(0)
.Color = 13434879
End With
With .Add(1)
.Color = 49407
End With
End With
End With
End With
== Festlegen der 6.Bedingung -
countFormat = countFormat + 1
Cells(4, 2).Activate
With Range(Cells(4, 2), Cells(lastRow, countColumn))
.FormatConditions.Add xlExpression, Formula1:="=BlaBlaBla"
With .FormatConditions(countFormat)
.Priority = (countFormat)
.StopIfTrue = False
.Interior.Pattern = xlPatternRectangularGradient
.Interior.Gradient.RectangleLeft = 0.5
.Interior.Gradient.RectangleRight = 0.5
.Interior.Gradient.RectangleTop = 0.5
.Interior.Gradient.RectangleBottom = 0.5
With .Interior.Gradient.ColorStops
.Clear
With .Add(0)
.Color = 13434879
End With
With .Add(1)
.Color = 49407
End With
End With
End With
End With
End Sub