Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1692to1696
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
1692to1696
1692to1696
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Shapes löschen - Laufzeitfehler 1004

Shapes löschen - Laufzeitfehler 1004
16.05.2019 13:57:06
Markus
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

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

Betreff
Datum
Anwender
Anzeige
AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 14:07:53
cysu11
Hallo Markus,
also beim mir läuft der Code wunderbar durch und mach das was es soll!
Wenn dein Problem weiterhin besteht, lade bitte deine Datei hoch!
LG
Alexandra
AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 14:15:23
Beverly
Hi Markus,
dann gibt es anscheinend weitere Objekte im Tabellenblatt, die auch als Shape erkannt werden aber nicht auf die herkömmliche Weise gelöscht werden können und deshalb zu einem Laufzeitfehler führen. Eventuell hilft dann ja On Error Resume Next.

AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 15:34:12
Markus
Hallo,
vielen Dank für die schnelle Rückmeldung!
Ich glaube das Problem gefunden zu haben:
In B3 & B4 verwende ich Dropdownlisten, welche scheinbar den Error verursachen.
Sobald ich die von Beverly vorgeschlagene "On Error Resume Next" Lösung einbaue, läuft der Code durch, allerdings wird dann auch die Dropdown-Funktion der Liste gelöscht, das heißt der zuvor ausgewählte Wert der Liste steht dann einfach "fest" im Feld drin und ich habe keine Dropdown-Funktion mehr.
Da muss ich mir noch etwas einfalle lassen..
Danke schon einmal :)
Markus
Anzeige
AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 15:40:38
Torsten
Hi Markus
Dann klammer doch diese Range auch noch aus, so wie die andere Range auch.
Gruss Torsten
AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 15:51:29
Beverly
Hi Markus,
dann schreibe die Codezeile zum Löschen wie folgt:
        If shaShape.Type = msoAutoShape Then shaShape.Delete
und lasse selbstverständlich On Error weg.

AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 16:00:57
Markus
Hi Beverly,
wie genau meinst du das? Da langen meine Grundkenntnisse leider nicht ganz..
Sub DeleteShapes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shpShape.Type = msoAutoShape Then shpShape.Delete
Next shp
End Sub
So bekomme ich einen Fehler (Objekt erforderlich).
Sorry für die Rückfrage und danke für deine / eure Hilfe!
Markus
Anzeige
AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 16:04:19
cysu11
Hi Markus,
das "shpShape.Delete" ersetzen mit "shp.Delete"
LG
Alexandra
AW: Shapes löschen - Laufzeitfehler 1004
16.05.2019 16:06:07
Beverly
Hi Markus,
na in deinem Ursprungscode hattest du doch noch die Prüfung drin, ob sich das Shape in dem festgelegten Bereich befindet - dies muss natürlich erhalten bleiben.
Wenn du dann immer noch Probleme hast, solltest du auf jeden Fall deine Mappe hochladen.

Ergänzung
16.05.2019 16:16:40
Beverly
Hi Markus,
ich habe geade gesehen, dass du eine andere Variablenbezeichnung verwendest als ich: bei mir ist es shaShape, bei dir shp - du musst im Code also noch shpShape durch shp ersetzen.

Anzeige
AW: Ergänzung
20.05.2019 11:54:55
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
Anzeige
AW: Laufzeitfehler 1004 - jetzt mit Beispielmappe
20.05.2019 12:57:25
Markus
Hatte vergessen, das Häkchen bei "noch offen" zu drücken.
Daher bitte "siehe Nachricht unten" :)
Danke und Gruß
Markus
AW: Laufzeitfehler 1004 - jetzt mit Beispielmappe
20.05.2019 13:23:13
peterk
Hallo
Mach folgende Änderung:
        For Each shp In ActiveSheet.Shapes
            If shp.Type = msoAutoShape Then
              If Intersect(shp.TopLeftCell, Range("A1:I1")) Is Nothing Then shp.Delete
            End If
        Next shp


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Anzeige
AW: Ergänzung
20.05.2019 13:10:19
Beverly
Hi Markus,
der DropDown-Pfeil der Gültigkeitszelle ist vom AutoShapeType her msoShapeMixed, alle anderen sind vom Typ msoShapeRectangle - darauf kannst du dich in deinem Code beziehen:
  For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeRectangle Then
If Intersect(shp.TopLeftCell, Range("A1:I1")) Is Nothing Then shp.Delete
End If
Next shp
Du brauchst dann auch die andere Schleife für die Textfelder nicht, da sie ebenfalls als msoShapeRectangle erkannst werden.

Anzeige
AW: Ergänzung
20.05.2019 13:33:26
cysu11
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
Anzeige
AW: Ergänzung - Laufzeitfehler gelöst
20.05.2019 13:37:06
Markus
Hi Karin & Alexandra,
vielen Dank für Eure schnelle und freundliche Hilfe!
Nun läuft das Makro ohne Fehler :)
Nochmals lieben Dank und noch einen schönen Tag.
Grüße
Markus

Links zu Excel-Dialogen

Frame Label

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige