Shapes löschen - Laufzeitfehler 1004

Markus · 2019-05-16T13:57:06+00:00

Hallo liebe Community, ich habe ein kleines Makro, welches mir zuvor erstellte Shapes in einem bestimmten Bereich löschen soll. Alle Shapes im Range A1:J1 sollen bleiben, der Rest soll weg. Sub DeleteShapes() Dim shp As Shape For Each shp In ActiveSheet.Shapes If Intersect(shp.TopLeftCell, Range("A1:I1")) Is Nothing Then shp.Delete Next shp End Sub So habe ich den Teil in meinem Makro stehen. An für sich funktioniert er auch und löscht mir nacheinander alle Shapes wie gewünscht. Sobald er jedoch keine Shapes mehr findet, meldet er den Laufzeitfehler 1004 "Anwendungs- oder objektdefinierter Fehler". Leider finde ich nicht, was ich falsch gemacht habe. Könnt ihr mir hier weiterhelfen? Danke vorab! Grüße Markus

Hallo zusammen,
vielen Dank für die Tipps vergangene Woche. Leider bin ich erst jetzt dazu gekommen, diese zu testen.
Ich habe die Bedingung

If Intersect(shp.TopLeftCell, Range("A1:I1")) Is Nothing And shp.Type = msoAutoShape Then shp.Delete

eingebaut und ebenso auch die Bedingung

If txt.Type = msoTextBox Then txt.Delete

da es auch einige generierte Textboxen gibt.
Der Code an für sich scheint zu funktionieren, jedoch bleibt in meiner Mappe das Problem nach wie vor bestehen. Der Code startet über einen Worksheet_Change Befehl in den Feldern B3 oder B4. Tippe ich hier händisch eine Änderung ein, so klappt alles. Ihr könnt die Werte im Bereich A8:B9 ändern um zu sehen, dass der Code sauber läuft (dadurch ändert sich die Größe der Shapes). Das orangene Shape oben bleibt wie gewünscht erhalten.
Sobald ich den Change jedoch über eine Dropdownliste aktiviere, erhalte ich weiterhin den Fehler.
Daher im Anhang nun auch mal eine Beispielmappe. Dort startet der Code, sobald man jetzt z.B. die Palette "A" in eine Palette "B" ändert. Alles läuft wie es soll. Bitte ändert anschließend das Feld B3 in den Datenüberprüfungstyp "Liste" um und wählt die Werte "A,B,C" aus Tabellenblatt 2 aus.
Nutze ich nun die Liste zum Ändern des Zellwertes, so erhalte ich wieder den Laufzeitfehler 1004.
Ich verstehe leider nicht, was hier zum Problem führt...
Link zur Datei:
https://www.herber.de/bbs/user/129894.xlsm

Hallo Markus,
oder du schließt den Dropdown nach Name aus!

Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim shp As Shape
Dim txt As Shape
Dim L?ngePal As Integer
Dim BreitePal As Integer
Dim L?ngeBox As Integer
Dim BreiteBox As Integer
Set KeyCells = Range("B3:B4")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
For Each shp In ActiveSheet.Shapes
If shp.Name  "Drop Down 1" Then
MsgBox shp.Name
If Intersect(shp.TopLeftCell, Range("A1:I1")) Is Nothing And shp.Type = msoAutoShape Then  _
shp.Delete
End If
Next shp
For Each txt In ActiveSheet.Shapes
MsgBox txt.Name
If txt.Type = msoTextBox Then txt.Delete
Next txt
L?ngePal = Range("A8").Value / 5
BreitePal = Range("A9").Value / 5
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 200, 50, L?ngePal, BreitePal).Name = "Palette"
ActiveSheet.Shapes("Palette").Fill.ForeColor.RGB = RGB(255, 228, 181)
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 200 + (L?ngePal / 2.8), 33, 60, 150). _
TextFrame.Characters.Text = Range("A8").Value & " mm"
ActiveSheet.Shapes.AddLabel(msoTextOrientationVerticalFarEast, 147, 50 + (BreitePal / 2.8), 60,  _
60).TextFrame.Characters.Text = Range("A9").Value & " mm"
L?ngeBox = Range("B8").Value / 5
BreiteBox = Range("B9").Value / 5
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 500, 50, L?ngeBox, BreiteBox).Name = "Beh?lter"
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 500, 33, 60, 150).TextFrame. _
Characters.Text = Range("B8").Value & " mm"
ActiveSheet.Shapes.AddLabel(msoTextOrientationVerticalFarEast, 448, 50, 60, 60).TextFrame. _
Characters.Text = Range("B9").Value & " mm"
End If
End Sub

LG
Alexandra

Shapes löschen - Laufzeitfehler 1004

Forumthread: Shapes löschen - Laufzeitfehler 1004

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Shapes löschen - Laufzeitfehler 1004

Forumthread: Shapes löschen - Laufzeitfehler 1004

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread