Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 15:30:14
Warum Verweis zeigt Falsch an
20.04.2024 14:03:38
Http-Request (POST) für GraphQL API-Abfrage
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
528to532
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
528to532
528to532
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ovale Shapes verändern

Ovale Shapes verändern
07.12.2004 15:00:07
Gregor
Hallo
Mit folgendem Code setze ich alle Shapes auf einem Blatt auf gelb:

Sub ShapesFaerben()
Dim i%, varArr()
ReDim varArr(ActiveSheet.Shapes.Count)
For i = 1 To UBound(varArr)
varArr(i) = i
Next i
ActiveSheet.Shapes.Range(varArr).Fill.ForeColor.SchemeColor = 5
End Sub

Kann ich den Code verändern, dass es mir nur die ovalen Shapes gelb einfärbt und alle rechteckigen Shapes unverändert lässt.
Danke Gregor

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ovale Shapes verändern
Udo
Abfrage, ob Autoshapetype = msoShapeOval
Udo
AW: Ovale Shapes verändern
Gregor
Udo
Ja aber wie mache ich diese Abfrage, mein Versuch scheiterte.

Sub ShapesOval()
Dim i%, varArr()
ReDim varArr(ActiveSheet.Shapes.Count)
For i = 1 To UBound(varArr)
If ActiveSheet.Shapes = Shape(msoShapeOval) Then
varArr(i) = i
End If
Next i
ActiveSheet.Shapes.Range(varArr).Fill.ForeColor.SchemeColor = 5
End Sub

Danke Gregor
AW: Ovale Shapes verändern
Udo
If ActiveSheet.Shapes(i).AutoSpapeType = msoShapeOval Then
Udo
AW: Ovale Shapes verändern
Gregor
Udo
Danke, habe es mit folgendem Code Probiert, generiert aber die Fehlermeldung "Objekt unterstützt diese Eigenschaft oder methode nicht.
Option Base 1

Sub ShapesOval()
Dim i%, varArr()
ReDim varArr(ActiveSheet.Shapes.Count)
For i = 1 To UBound(varArr)
If ActiveSheet.Shapes(i).AutoSpapeType = msoShapeOval Then
varArr(i) = i
End If
Next i
ActiveSheet.Shapes.Range(varArr).Fill.ForeColor.SchemeColor = 5
End Sub

Gruss Gregor
Anzeige
AW: Ovale Shapes verändern
Udo
Falsch: AutoSpapeType
Richtig: AutoShapeType
Udo
AW: Ovale Shapes verändern
Gregor
Hoi Udo
Danke für die Korrektur, ist mir nicht aufgefallen. Irgendwie funktioniert das bei mir nicht, erhalte diesmal die Fehlermeldung "Der Index in der angegebenen Sammlung ist ausserhalb des zulässigen Bereichs".
Konnte es aber Dank deiner Hilfe wie folgt lösen:

Sub ShapesOval1()
Dim i%, varArr()
ReDim varArr(ActiveSheet.Shapes.Count)
For i = 1 To UBound(varArr)
If ActiveSheet.Shapes(i).AutoShapeType = msoShapeOval Then
ActiveSheet.Shapes(i).Fill.ForeColor.SchemeColor = 5
End If
varArr(i) = i
Next i
End Sub

Gruss Gregor
Anzeige
AW: Ovale Shapes verändern
Udo
Du kannst den ganzen Umweg über den Array weglassen:

Sub ShapesOval1()
Dim i%
For i = 1 To ActiveSheet.Shapes.count
If ActiveSheet.Shapes(i).AutoShapeType = msoShapeOval Then
ActiveSheet.Shapes(i).Fill.ForeColor.SchemeColor = 5
End If
Next i
End Sub

AW: Ovale Shapes verändern
Gregor
Hoi Udo
Das ist wirklich die einfachere Lösung und klappt super, vielen Dank für deine Ausdauer.
Gruss Gregor

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige