Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1584to1588
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

Kreisgrafik mit Viertel Farbänderungen

Kreisgrafik mit Viertel Farbänderungen
24.10.2017 15:40:51
Dieter(Drummer)
Guten Tag VBA Speialisten,
anbei meine Musterdatei, in der eine Grafik ist.
Sie besteht aus aus einem Kreis, der 3/4tel hat und einem 1/4tel. Beide sind gruppiert. Das 3/4 heißt "Dreiviertel" und das 1/4 heißt "Einviertel". Die Gesamtgruppierung heißt "Kreis".
In der Datei sind 2 Makros, eins für "rechtsrum" und eins für "linksrum", Beide funtionieren gut.
Mein Wunsch: Mit jedem Klick auf die Button 1 und 2, soll sich nur die Farbe von "Einviertel" ändern. Welche Farben möglich wären, habe ich in der Datei angegeben. Z.B. in RGB, Excel Index, Excel Farbindex und die Farbe selbst.
Freue mich auf Hilfe.
Mit Gruß, Dieter(Drummer)
https://www.herber.de/bbs/user/117196.xlsm

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kreisgrafik mit Viertel Farbänderungen
24.10.2017 16:01:35
Nepumuk
Hallo Dieter,
die zweite Routine schaffst du selbst:
Sub rechtsrum()
    Static slngStep As Long
    Dim objShp As Shape
    Set objShp = Worksheets("Tabelle1").Shapes("Kreis")
    
    objShp.Rotation = objShp.Rotation + 45
    
    Set objShp = Nothing
    slngStep = slngStep + 1
    With Tabelle1.Shapes("Bogen 1").Fill.ForeColor
        Select Case slngStep
            Case 1: .RGB = RGB(0, 0, 255)
            Case 2: .RGB = RGB(255, 255, 0)
            Case 3: .RGB = RGB(255, 0, 255)
            Case 4: .RGB = RGB(0, 255, 0)
            Case 5: .RGB = RGB(128, 128, 128)
            Case 6: .RGB = RGB(192, 192, 92)
            Case 7: .RGB = RGB(0, 128, 0)
            Case 8: .RGB = RGB(255, 0, 0)
                slngStep = 0
        End Select
    End With
    'Beep 880, 300
End Sub

Gruß
Nepumuk
Anzeige
AW: Einfach perfekt ...
24.10.2017 16:10:38
Dieter(Drummer)
... nach meinem Wunsch, Nepumuk. Den Code "linksrum" bekommen ich wohl hin, da du ja mir eine prima Lösung geschaffen hast.
Herzlichen Dank und einen schönen Resttag, wünscht dir
Dieter(Drummer)
AW: Einfach Schickimicki ...
26.10.2017 12:43:05
Luschi
Hallo Dieter,
ich hoffe, Du machst das nicht wie die Autoindustrie: schönes Blech ringsrum, aber die inneren Werte sind pfui...
Gruß von Luschi
aus klein-Paris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige