Bedingte Formatierung einer Form

Hallo allerseits,
möchte eine Form mittels bedingter Formatierung farblich ändern. Dies geht aber nicht bzw. muss über VBA gelöst werden. Dazu habe ich hier in der Recherche folgendes gefunden:

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D3") = 0 Then
ActiveSheet.Shapes.Range(Array("Oval 2")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
Range("D3").Select
ElseIf Range("D3") = 1 Then
ActiveSheet.Shapes.Range(Array("Oval 2")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
.Solid
End With
Range("D3").Select
End If
End Sub

und die Kurzform:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D3") = 1 Then
Shapes("Oval 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf Range("D3") = 0 Then
Shapes("Oval 1").Fill.ForeColor.RGB = RGB(0, 255, 0)
End If
End Sub

Hierbei handelt es sich aber um einen Kreis. Ich benötige aber folgendes:

WENN(M4 größer L4/24

dann sollen die Linien schwarz werden.

WENN(M4 kleiner L4/24

dann sollen die Linien Rot werden. Habe dazu mal den Makrorekorder laufen lassen um überhaupt mal zu sehen, was da so passiert. Form ist schwarz und wird in Rot gefärbt.

Sub Makro1()
'
' Makro1 Makro
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 7")).Select
    With Selection.ShapeRange.Line
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0.0899999738
    End With
End Sub

Hat da jemand ne Idee/Lösung parat?

Gruß Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro1() ' ' Makro1 Makro ActiveSheet.Shapes.Range(Array("Rounded Rectangle 7")).Select With Selection.ShapeRange.Line .Visible = msoTrue If Range("M4").Value Range("L4").Value / 24 Then .ForeColor.RGB = RGB(255, 0, 0) Else .ForeColor.RGB = RGB(0, 0, 0) End If End With End Sub

Sub Unit() With ActiveSheet.Shapes("Rounded Rectangle 7") .Line.Visible = msoTrue .Line.Weight = xlThick .Line.ForeColor.RGB = IIf(.Parent.Range("M4").Value _ .Parent.Range("L4").Value / 24, RGB(255, 0, 0), RGB(0, 0, 0)) End With End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("L4:M4")) Is Nothing Then Application.EnableEvents = False Call Unit Application.EnableEvents = True End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("A1:B1")) Is Nothing Then Application.EnableEvents = False Call Tabelle1.Unit ' With ActiveSheet.Shapes("Rounded Rectangle 1") ' .Line.Visible = msoTrue ' .Line.Weight = xlThin ' .Line.ForeColor.RGB = IIf(.Parent.Range("B1").Value _ ' .Parent.Range("A1").Value / 24, RGB(255, 0, 0), RGB(0, 0, 0)) ' End With Application.EnableEvents = True End If End Sub Sub Unit() With ActiveSheet.Shapes("Rounded Rectangle 1") .Line.Visible = msoTrue .Line.Weight = xlThin .Line.ForeColor.RGB = IIf(.Parent.Range("B1").Value _ .Parent.Range("A1").Value / 24, RGB(255, 0, 0), RGB(0, 0, 0)) End With End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:B1")) Is Nothing Then Application.EnableEvents = False ' Call Tabelle1.Unit With ActiveSheet.Shapes("Rounded Rectangle 1") .Line.Visible = msoTrue .Line.Weight = xlThin .Line.ForeColor.RGB = IIf(.Parent.Range("B1").Value _ .Parent.Range("A1").Value / 24, RGB(255, 0, 0), RGB(0, 0, 0)) End With Application.EnableEvents = True End If End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread