Thema: Darstellung eines Prozentwertes in einem Balken | Herbers Excel-Forum

Hallo zusammen,
ich möchte eine prozentuale Auslastung in einem Balken darstellen.
Der Balken soll folgende Einteilung haben:
Von 0 - 80 % grün, transparent
von 80,01 - 90 % gelb, transparent
und von 90,01 - 100 % rot, transparent.
Wenn die tatsächliche Auslastung nun z. B. 52 % beträgt, soll der Anteil auf dem Balken in grün, Vollfarbe dargestellt werden. Ab 52,01 % soll die Darstellung weiterhin transparent sein.
Zur Zeit habe ich das in 5 % Schritten gelöst, dazu die Würfel vorher erstellt und benannt (Entw5; Entw10 ... Entw100) und dann in Abhängigkeit der Auslastung die Farbe zugewiesen.
Ich habe den code im Anschluss angefügt.
Ich möchte aber nicht in 5 %-Schritten arbeiten, sondern mit einer oder zwei Nachkommestellen. Dazu taugt aber weder mein code noch die vorgezeichneten Würfel.
Lässt sich so etwas in VBA umsetzen? Also erst ein Balken erstellen, die Grenzwerte (80% und 90 %) entsprechend einfärben und dann noch der Wert (als Vollfarbe) darstellen? Wenn ja, wie?
Der Gipfel wäre ein kleiner Marker in Form eines Pfeiles oder Striches bei der aktuellen Auslastung, wie oben z. B. 52 %.
Für Eure Hilfe schon mal besten Dank!
Michael
code:

Dim e As Double     'Variable für Auslastung dynamisch
e = wks.Cells(7, 33)
If e > 1 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0
End If
If e <= 1 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0
End If
If e <= 0.95 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.9 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.85 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.8 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.75 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.7 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.65 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.6 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.55 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.5 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.45 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.4 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.35 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.3 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.25 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.2 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.15 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.1 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If
If e <= 0.05 Then
ActiveSheet.Shapes("Entw5").Fill.ForeColor.TintAndShade = 0
ActiveSheet.Shapes("Entw10").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw15").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw20").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw25").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw30").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw35").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw40").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw45").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw50").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw55").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw60").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw65").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw70").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw75").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw80").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw85").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw90").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw95").Fill.ForeColor.TintAndShade = 0.8
ActiveSheet.Shapes("Entw100").Fill.ForeColor.TintAndShade = 0.8
End If

Hi Michael,
ich würd das ohne Code machen:
6-spaltige Tabelle als Ausgang:
mit den Werten 80;10;10;52;0;0
für einen Wert 85:
80;10;10;80;5;0
die ersten 3 Spalten formatierst du mit den transparenten Farben, die nächsten 3 Spalten mit den Vollfarben.
die letzteren 3 Spalten ordnest du der Sekundärachse zu, natürlich jeweils Säule gestapelt,
beide Maßstäbe gleich setzen. die Werte der Sekundärachse überlagern die Primärachse.
du mußt also nur noch ein bisserl Rechenarbeit mit wenn machen um die 4,5,6, Spalte zu füllen.
wenns nötig ist, mach ich am Abend ein Beispiel
Gruss
M@x

Hallo M@x,
danke, das ist ein intressanter Gedanke. Werde ich heute abend mal probieren. Kann mir im Augenblick noch nicht ganz vorstellen, wie das Ergebnis aussehen wird.
Da der Balken jedoch öfter mit verschiedenen Einstellungen und Werten abgerufen wird, brauch ich die Lösung über VBA.
Liebe Grüße
Michael

Hallo M@x,
das mit dem Diagramm funktioniert prima. Danke für die Anregung!
Liebe Grüße
Michael

Hi.
Ist doch ganz einfach: Du erzeugst zwei Balken der gleichen Höhe und mit gleichem Startpunkt links.
Der im Hintergrund (Name HinterGrund) ist transparent, der im Vordergrund (Name Prozent) bekommt die Farbe, die Du haben willst.
Der Code sieht dann so aus (in dem Fall reagiert er auf Änderung des Wertes von Zelle A2):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim werT As Double
If Target.Address = Range("A2").Address Then
werT = Range("A2").Value
Shapes("Prozent").Width = _
Application.Min(Application.Max(0, _
werT * Shapes("HinterGrund").Width), Shapes("HinterGrund").Width)
'    ' Ausgeschrieben wäre das so:
'        If werT >= 1 Then
'            Shapes("Prozent").Width = Shapes("HinterGrund").Width
'        ElseIf werT <= 0 Then
'            Shapes("Prozent").Width = 0
'        Else
'            Shapes("Prozent").Width = werT * Shapes("HinterGrund").Width
'        End If
End If
End Sub

Gruss, Jogy

Hallo Jogy,
recht herzlichen Dank, ich glaube das ist es - was ich suche.
Kannst Du mir bitte sagen, wass es mit der folgenden Zeile auf sich hat, was passiert da?
"If Target.Address = Range("A2").Address Then"
Danke
Liebe Grüße
Michael

If Target.Address = Range("A2").Address Then
ist verkorkst, besser:
If Target.Address = "$A$2" Then
zu deutsch: Wenn die geänderte Zelle A2 ist, dann...

Hallo F1,
schönen Dank - wieder was gelernt!
Liebe Grüße
Michael

Hi.
Verkorkst? Naja, eher in dem Fall etwas zu kompliziert. Allgemein bietet das aber mehr Möglichkeiten, wenn die Vergleichszelle variabel ist. Wobei es dann aber zugegebenermaßen besser wäre, mit Cells anstelle von Range zu arbeiten, da es dann schleifenkompatibel ist.
Gruss, Jogy