Aktualisieren von Shapes mit VBA
08.03.2017 14:20:58
Shapes
ich habe folgendes Problem und hoffe ihr könnt mir weiterhelfen.
Ich habe in meinem Tabellenblatt eine Autoform (Rechteck), welches die Größe anhand eines Zelleninhalts verändern soll. Das funktioniert soweit auch sehr gut mit Code den ich mir zusammengebastelt habe:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("I11") Then
ActiveSheet.Shapes("Rechteck1").Select
With Selection
.Top = 119
.Left = 421
.ShapeRange.Fill.ForeColor.RGB = Rechteck1_Farbe(Target.Value)
.ShapeRange.Height = 38
.ShapeRange.ScaleHeight Rechteck1_Height(Target.Value), msoFalse,
_msoScaleFromBottomRight
End With
Target.Select
End If
End Sub
Private Function Rechteck1_Farbe(dblWert As Long) As Long
Select Case dblWert
Case Is >= 20
Rechteck1_Farbe= RGB(124, 252, 0)
Case Else
Rechteck1_Farbe= RGB(124, 252, 0)
End Select
End Function
Private Function Rechteck1_Height(dblWert)
Select Case dblWert
Case Is >= 100
Rechteck1_Height= 1
Case Is >= 90
Rechteck1_Height= 0.9
Case Is >= 80
Rechteck1_Height= 0.8
Case Is >= 70
Rechteck1_Height= 0.7
Case Is >= 60
Rechteck1_Height= 0.6
Case Is >= 50
Rechteck1_Height= 0.5
Case Is >= 40
Rechteck1_Height= 0.4
Case Is >= 30
Rechteck1_Height= 0.3
Case Is >= 20
Rechteck1_Height= 0.21
Case Is >= 10
Rechteck1_Height= 0.2
Case Is >= 0
Rechteck1_Height= 1
Case Else
ZPV_Anzahl_Height = 1
End Select
End Function
Gibt es nun die Möglichkeit, dass sich durch das Ändern des Zelleninhalts sich auch automatisch die Form und Farbe des Rechtecks ändert? Ohne das ich manuell in die Zelle klicken muss.
Danke & Gruß