Microsoft Excel

Herbers Excel/VBA-Archiv

Darstellung eines Prozentwertes in einem Balken | Herbers Excel-Forum


Betrifft: Darstellung eines Prozentwertes in einem Balken von: MB
Geschrieben am: 23.11.2009 14:28:14

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

  

Betrifft: alternativ von: M@x
Geschrieben am: 23.11.2009 15:19:57

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


  

Betrifft: AW: alternativ von: MB
Geschrieben am: 23.11.2009 15:56:39

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


  

Betrifft: AW: alternativ von: MB
Geschrieben am: 23.11.2009 23:30:10

Hallo M@x,

das mit dem Diagramm funktioniert prima. Danke für die Anregung!

Liebe Grüße
Michael


  

Betrifft: AW: Darstellung eines Prozentwertes in einem Balken von: JogyB
Geschrieben am: 23.11.2009 15:53:06

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


  

Betrifft: AW: Darstellung eines Prozentwertes in einem Balken von: MB
Geschrieben am: 23.11.2009 16:31:13

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


  

Betrifft: AW: Darstellung eines Prozentwertes in einem Balken von: F1
Geschrieben am: 23.11.2009 18:37:49

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...


  

Betrifft: AW: Darstellung eines Prozentwertes in einem Balke von: MB
Geschrieben am: 23.11.2009 21:50:19

Hallo F1,

schönen Dank - wieder was gelernt!

Liebe Grüße

Michael


  

Betrifft: AW: Darstellung eines Prozentwertes in einem Balken von: JogyB
Geschrieben am: 25.11.2009 08:33:29

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


Beiträge aus den Excel-Beispielen zum Thema "Darstellung eines Prozentwertes in einem Balken"