Anzeige
Archiv - Navigation
1636to1640
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ellipsen füllen. Code fehlen div. DIM's

Ellipsen füllen. Code fehlen div. DIM's
12.08.2018 16:39:32
Dieter(Drummer)
Guten Tag VBA Spezialisten,
anbei meine Musterdatei mit entsprechendem Code (nicht von mir!).
Codeprobleme treten an versch. Stellen auf, z.B. fehlende DIM Anweisungen, bei denen ich nicht weiter komme.
Per Code sollen die Ellipsen mit Farbe gefüllt werden, nach den Prozentwerten in Zeile 2.
Es wäre toll, wenn mir da jemand helfen könnte, den Code lauffähig zu machen, obwohl er nicht von mir ist.
Mit Gruß und anbei die Musterdatei: https://www.herber.de/bbs/user/123281.xlsm
Dieter(Drummer)

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ellipsen füllen. Code fehlen div. DIM's
12.08.2018 17:12:08
Gerd
Hallo Dieter,
hast du vergessen, den (bisherigen) Code mit hochzuladen?
Gruß Gerd
Der Code kann nicht funktioinieren...
13.08.2018 08:06:22
Beverly
Hi Dieter,
...da er sich auf ein Diagramm bezieht - du jedoch verwendest eine Form vom Typ Ellipse. Das Problem liegt also nicht (nur) in der fehlenden Variablendeklaration.
Zeichne einfach den Code auf, wie du die Ellipse von Hand färbst.


AW: Der Code kann nicht funktioinieren...
13.08.2018 08:51:03
Dieter(Drummer)
Guten Morgen Karin,
danke für deine Rückmeldung. Ich habe inzwischen den korrekten Code gefunden und sobald ich es dann fertig habe, stelle ich gerne eine Musterdatei hier ein. Evtl. sind ja auch andere dran interessiert.
Sollte dennoch ein "Haken" auftauchen, nehme ich gerne deine Hilfe in Anspruch.
Gruß, Dieter(Drummer)
Anzeige
AW: Neue Datei mit Code, aber ein Fehler ..
13.08.2018 09:32:53
Dieter(Drummer)
Guten Morgen Karin,
hier nun die Datei mit dem richtigen Code (nicht von mir!):
https://www.herber.de/bbs/user/123288.xlsm
Es tritt ein Fehler auf (Laufzeitfehler 1004: Die Methode 'Range' für das Objekt '_Global' ist fehlgeschlagen):
.Fill.GradientStops(2).Color.RGB = RGB(Range("Rot").Value, Range("Blau").Value, Range("Grün").Value)
Mit der Bitte um Hilfe, grüßt
Dieter(Drummer)
Es gibt 2 Fehler in deiner Tabelle...
13.08.2018 11:33:59
Beverly
Hi Dieter,
1. die im Code angesprochene Zelle enthält keinen %-Wert
2. es gibt keine Zellen mit dem Namen "Rot", "Grün" und "Blau" gibt, in denen die jeweiligen Stop-Werte stehen
Das erste Problem kann man lösen, indem man in der Schleife mit einer Variablen nach der Zelle mit dem Namen der Ellipse sucht und die Zahl aus der Zelle darunter nimmt:
Dim rngZelle As Range
AnzahlFormen = ActiveSheet.Shapes.Count
ElliNr = 0
For i = 1 To AnzahlFormen
If Left(ActiveSheet.Shapes(i).Name, 7) = "Ellipse" Then
ElliNr = ElliNr + 1
Set rngZelle = Cells.Find("Ellipse" & i, lookat:=xlWhole)
Prozentwert = rngZelle.Offset(1, 0)
'... hier der weitere Code

Das 2. Problem kannst du lösen indem du 3 Zellen entsprechend definierst und mit Zahlen belegst


Anzeige
AW: Es gibt 2 Fehler in deiner Tabelle...
13.08.2018 12:25:25
Dieter(Drummer)
Hallo Karin,
Danke erstmal für deine weitere Hilfe.
In den Zellen B2, C2, und C2, sind Prozentwerte und so formatiert, und die Farbwerte sind in I4:I6, im Tab1.
Es sollen ja die Ellipsen mit den Farben in Prozentanteil eingefügt werden.
Deinen Code konnte ich nicht korrekt einfügen und deshalb bitte ich nochmal um deine Hilfe. Ich bin halt nicht soweit in VBA, aber das Thema ist einfach interessant.
Gruß, Dieter(Drummer)
AW: Es gibt 2 Fehler in deiner Tabelle...
13.08.2018 14:08:11
Beverly
Hi Dieter,
dsas die Zellen B2, C2 und D2 die %-Werte enthalten ist mir schon klar, aber dein Ursprungs-Code greift auf die falschen Zellen zu.
Du musst außerdem der Zelle I4 den Namen "Rot", der Zelle I5 den Namen "Grün" und der Zelle I6 den Namen "Blau" geben, damit dein Code darauf zugreifen kann, und nicht nur Rot, Grün und Blau in die Zellen links davon schreiben.
Public Sub Fuellstand()
'Andreas Thehos, at IT-Training & Beratung, 2012
Dim AnzahlFormen As Integer
Dim i As Integer
Dim Grenze1 As Double
Dim Grenze2 As Double
Dim Formname As String
Dim Prozentwert As Double
Dim ElliNr As Integer
Dim rngZelle As Range
AnzahlFormen = ActiveSheet.Shapes.Count
' ElliNr = 0 = 1 Then
Grenze1 = 0
Grenze2 = 0
End If
With ActiveSheet.Shapes("Ellipse" & ElliNr)
.Fill.TwoColorGradient msoGradientHorizontal, 1
.Fill.GradientStops(1).Color.RGB = RGB(220, 220, 220)
.Fill.GradientStops(1).Position = Grenze1
.Fill.GradientStops(2).Color.RGB = RGB(Range("Rot").Value, _
Range("Blau").Value, Range("Grün").Value)
.Fill.GradientStops(2).Position = Grenze2
End With
End If
End If
Next i
End Sub
https://www.herber.de/bbs/user/123306.xlsm


Anzeige
AW: Absolut perfekt, wie ...
13.08.2018 14:22:29
Dieter(Drummer)
Hallo Karin,
... ich es haben wollte und ich habe wieder dazu gelernt.
Werde mir die VBA Unterschiede deines geänderten Codes mit dem vorherigen in Ruhe ansehen.
Herzlichen Dank und einen erfreulichen Tag.
Gruß, Dieter(Drummer)
AW: Farbzellen habe ich ...
13.08.2018 12:39:44
Dieter(Drummer)
Hallo Karin,
... jetzt die Zelle, die die Farbangabe haben, mit Namen definiert versehen "Rot", Grün" und "Blau" und das geht schonmal. Nun fehlt nur noch, wo ich genau den Code von dir einfügen muss.
Mit der Bitte um nochmalige Hilfe, grüß
Dieter(Drummer)
AW: Noch Zusatzangabe in Datei anbei
13.08.2018 10:17:45
Dieter(Drummer)
Hallo Karin,
hatte noch etwas in Tab1 (Farbangaben)dazu gesetzt, Fehler ist aber noch immer da.
Freue mich auf deine evtl. Hilfe.
Gruß, Dieter(Drummer)
Neue Datei: https://www.herber.de/bbs/user/123292.xlsm
Anzeige
AW: kein Vergleich zu Thehos ...
13.08.2018 11:09:25
Fennek
Hallo,
vermutlich gibt es deutliche Unterschiede der xl-Versionen. Mit xl2016 geht:

Sub ColorGradient()
'Oval1 anlegen
Dim Shp As Shape
Set Shp = ActiveSheet.Shapes(1)
Debug.Print Shp.Name
Shp.Fill.TwoColorGradient msoGradientHorizontal, 2 'Anzahl der Splits
Shp.Fill.GradientStops(1).Color.RGB = RGB(100, 0, 0)
Shp.Fill.GradientStops(2).Color.RGB = RGB(0, 100, 0)
Set Shp = Nothing
End Sub
mfg
AW: Danke Fennek, aber ich wollte ...
13.08.2018 12:19:34
Dieter(Drummer)
... etwas anderes. Es sollen die Ellipsen mit Farbe nach den Prozentwerten etc. gefüllt werden.
Deinen Code kann ich aber anderweitig verwenden.
Danke und Gruß,
Dieter(Drummer)
Anzeige
AW: Danke Fennek, aber ich wollte ...
13.08.2018 12:38:58
Fennek

Sub ColorGradient()
'Oval1 anlegen
Dim Shp As Shape
Set Shp = ActiveSheet.Shapes(1)
Debug.Print Shp.Name
Shp.Fill.TwoColorGradient msoGradientHorizontal, 3 'Anzahl der Splits
Shp.Fill.GradientStops(1).Position = 0.2
Shp.Fill.GradientStops(1).Color.RGB = RGB(100, 0, 0)
Shp.Fill.GradientStops(2).Position = 0.5
Shp.Fill.GradientStops(2).Color.RGB = RGB(0, 100, 0)
Shp.Fill.GradientStops(3).Position = 0.8
Shp.Fill.GradientStops(3).Color.RGB = RGB(0, 0, 1000)
Set Shp = Nothing
End Sub

AW: Danke Fennek, aber ...
13.08.2018 13:06:40
Dieter(Drummer)
Hallo Fennek,
... der Sinn der Sache ist, dass alle vorhanden Ellipsen, die eine Farbe bekommen, der Farbanteil ist mit Namen der Farbe definiert, den Farbanteil je Ellipse bekommen, der über der Ellipse in Prozent angegeben ist.
Dennoch ist dein 2. Code auch eine mögliche Variante, die ich anderweitig nutzen kann.
Gruß und Danke,
Dieter(Drummer)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige