Shapes löschen wenn vorhanden

Forumthread: Shapes löschen wenn vorhanden
2 Beiträge zu diesem Forumthread
Anzeige
VBA Beispiele zu verwandten Themen

Forumthread: Shapes löschen wenn vorhanden

19.06.2008 09:46:00

Gregor

Guten Morgen
Mit folgendem Code (aufgezeichnet) lösche ich Shapes mit den Namen Ellipse 1 bis 8.
ActiveSheet.Shapes.Range(Array("Ellipse 1", "Ellipse 2", "Ellipse 3", _
"Ellipse 4", "Ellipse 5", "Ellipse 6", "Ellipse 7", "Ellipse 8")).Select
Selection.Delete
Vorab muss ich aber mit einer If-Funktion noch prüfen, ob diese Shapes tatsächlich vorhanden sind, ansonsten wird ein Fehler generiert. Die Shapes sind nicht immer auf dem Blatt, es sind zudem noch viele andere Shapes mit anderen Namen vorhanden, die nicht gelöscht werden dürfen. Es handelt sich um AutoShapeType = msoShapeOval.
Wie lautete der Code dierser If-Bedingung?
Danke und Gruss
Gregor

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Shapes löschen wenn vorhanden

19.06.2008 10:05:25

Beverly
AW: Shapes löschen wenn vorhanden

19.06.2008 13:52:00

Gregor

AW: Shapes löschen wenn vorhanden

19.06.2008 10:05:25

Beverly

Hi Gregor,


Sub shapes_loeschen()
Dim bilder As Shape
Dim alle_bilder()
Dim counter As Integer
counter = 0
For Each bilder In ActiveSheet.Shapes
If bilder.AutoShapeType = msoShapeOval Then
Select Case bilder.Name
Case "Oval 1", "Oval 2", "Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", " _
Oval 8"
ReDim Preserve alle_bilder(0 To counter)
alle_bilder(counter) = bilder.Name
counter = counter + 1
End Select
End If
Next bilder
If Not IsEmpty(UBound(alle_bilder())) Then ActiveSheet.Shapes.Range(alle_bilder).Delete
End Sub