VBA - Farben Symbole | HERBERS Excel Forum

Hallo zusammen
Mit beigefügtem Makro ändere ich die Farbe verschiedener Symbole je nach Wert einer Zielzelle.
Wenn ich die Werte in mehrere Zielzellen (z.B. X5 und X6) miteinander einfüge erscheint jedoch ein "Laufzeitfehler 13 - Typen unverträglich". Wenn ich die Daten einzeln in jede Zelle einfüge klappt es.
Woran könnte dies liegen?


Private Function fctFarbe(dblWert As Double) As Byte
Select Case dblWert
Case Is > 100
fctFarbe = 11
Case Is


Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("x5") Then
ActiveSheet.Shapes("Ellipse 1").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
If Target = Range("x6") Then
ActiveSheet.Shapes("Ellipse 2").Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End With
Target.Select
End If
End Sub

Besten Dank für Eure Hilfe!
Gruss

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("X5")) Is Nothing Then ActiveSheet.Shapes("Ellipse 1").Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Range("X5").Value) Target.Select End If If Not Intersect(Target, Range("X6")) Is Nothing Then ActiveSheet.Shapes("Ellipse 2").Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(Range("X6").Value) Target.Select End If End Sub Private Function fctFarbe(dblWert As Double) As Byte Select Case dblWert Case Is > 100: fctFarbe = 11 Case Is

Private Sub Worksheet_Change(ByVal Target As Range) Dim rg As Range If Not Application.Intersect(Target, Union(Range("X4"), Range("X5"))) Is Nothing Then For Each rg In Target Select Case rg.Address(False, False) Case "X5" ActiveSheet.Shapes("Ellipse 1").Select With Selection .ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(rg.Value) End With Target.Select Case "X6" ActiveSheet.Shapes("Ellipse 2").Select With Selection .ShapeRange.Fill.ForeColor.SchemeColor = fctFarbe(rg.Value) End With Target.Select End Select Next rg End If Set rg = Nothing End Sub

Option Explicit Private Function fctFarbe(dblWert As Double) As Byte Select Case dblWert Case Is > 100: fctFarbe = 11 Case Is < 100: fctFarbe = 10 End Select End Function Private Sub Worksheet_Change(ByVal Target As Range) Dim Name As String If Not Intersect(Target, Range("X5:X6")) Is Nothing Then Name = IIf(Target.Address = "$X$5", " 1", " 2") With ActiveSheet.Shapes("Ellipse" & Name) .Fill.ForeColor.SchemeColor = fctFarbe(Target.Value) End With End If End Sub

Beliebteste Forumthreads (12 Monate)

VBA - Farben Symbole

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread