Grafiken nicht löschen

Forumthread: Grafiken nicht löschen

15.03.2025 10:32:55

UdPa

Hallo
Ich habe ein Excel Sheet in dem ich Daten eingebe und aber auch Zeichne, (Spielbericht)
Wenn alle Eingaben und Unterschridften eingeben sind, sende ich die Datei mittels Makro an meine Email Adresse.
Wenn alles erledigt ist setzte ich das Sheet zurück, also alle Eingaben werden gelöscht. Das auch die "Zeichnen" eingaben gelöscht werden habe ich diesen Code

Sub AlleZeichnungenLoeschen()
Dim shp As Shape
' Schleife durch alle Shapes im aktiven Arbeitsblatt
For Each shp In ActiveSheet.Shapes
shp.Delete ' Lösche das Shape
Next shp
MsgBox "Alle Zeichnungen wurden gelöscht."
End Sub

Mein Problem ist, das dieser Code auch Grafiken, Buttons und Textfelder löscht, kann mir wer helfen den Code so zu erweitern oder umschreiben das er wirklich nur "Zeichnen" löscht.

Vielen Dank für eure Hilfe

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Grafiken nicht löschen

15.03.2025 10:56:43

volti
AW: Grafiken nicht löschen

15.03.2025 12:53:33

Piet
AW: Grafiken nicht löschen

15.03.2025 14:46:02

Daniel
AW: Grafiken nicht löschen

15.03.2025 10:59:25

UdPa
AW: Grafiken nicht löschen

15.03.2025 11:06:50

UdPa
AW: Grafiken nicht löschen

15.03.2025 11:08:23

volti
AW: Grafiken nicht löschen

15.03.2025 11:05:51

volti
AW: Grafiken nicht löschen

15.03.2025 11:10:44

volti

AW: Grafiken nicht löschen

15.03.2025 10:56:43

volti

Hallo,

was ist denn "Zeichnen". Sind das Linien?

Hier wäre eine Beispieldatei, auch mit dem vorhandenen code, sinnvoll.

Beim Löschen könnte man die zu löschenden Objekte anhand des Typs einschränken oder bei der Erstellung der ggf. Linien wird jeweils ein eindeutiger Name vergeben, den man dann bei der Löschung berücksichtigt.

Oder alle nicht zu löschende Objekte mit einem entsprechenden Namen versehen.

Muster:

For Each shp In ActiveSheet.Shapes

 If shp.Name like "MeineLinie*" Then shp.Delete ' Lösche das Shape

Next shp

Gruß KarlHeinz

AW: Grafiken nicht löschen

15.03.2025 12:53:33

Piet

Hallo

hier mal ein Code mit dem du dir deine Objekte auflisten kannst. Den kann man beliebig erweitern um:
Top, Left, Width, Height, Placement, TopLeftCell.Address. TopLeftCell ist die Zelle wo sich Shapes befindet.

Amüsant und etwas verwirrend ist, das Shapes(j).Type eine Zahl ergibt, aber Shapes(j).TypeName NICHT funktioniert.
Mich wundert immer wieder, das die uralten Excel 95/97 Befehle -DrawingObjects- heute noch Ergebnisse bringen!

mfg Piet

Sub Objekte_auflisten()

With Sheets("Tabelle1")

   On Error Resume Next

   For j = 1 To ActiveSheet.Shapes.Count

       .Cells(j + 3, 1) = j

       .Cells(j + 3, 2) = ActiveSheet.Shapes(j).Name

       .Cells(j + 3, 3) = ActiveSheet.Shapes(j).Type

       .Cells(j + 3, 4) = ActiveSheet.DrawingObjects(j).Text

       .Cells(j + 3, 5) = TypeName(ActiveSheet.DrawingObjects(j))

   Next j

End With

End Sub

AW: Grafiken nicht löschen

15.03.2025 14:46:02

Daniel

Hi

Wie bereits geschrieben, alle Grafikobjekte, die nicht gelöscht werden dürfen umbenennen, so dass sie mit dem selben Text beginnen ("Bleibt" wurde ja vorgeschlagen)
Das kannst du von Hand machen (anklicken und das Namensfeld oben rechts benutzen) oder das Makro verwenden.

Zum Löschen dann:

For Each shp In ActiveSheet.Shapes

If not shp.Name like "Bleibt*" then shp.Delete ' Lösche das Shape

Next shp

Andere Möglichkeit:
Du zählst in der Vorlage die Vorhandenen Shapes (activesgeet.shapes.Count)
Alle neu hinzukommenden Shapes bekommen eine höhere Indexnummer
Lösche dann per Schleife alle Shapes mit der höheren Indexnummer
Der Code zum Löschen ist dann so, hier für 25 feste Shapes:

For x = 26 to activesheet.shapes.count

    ActiveSheet.shapes(26).delete

Next

Gruß Daniel

AW: Grafiken nicht löschen

15.03.2025 10:59:25

UdPa

Hallo
Da ich einen Touch Monitor habe ist Zeichnen eben mit Stift oder Finger zu unterschreiben

LG

AW: Grafiken nicht löschen

15.03.2025 11:06:50

UdPa

Oder alle nicht zu löschende Objekte mit einem entsprechenden Namen versehen.

Wie würde das gehen ?

AW: Grafiken nicht löschen

15.03.2025 11:08:23

volti

siehe Beitrag von eben...

AW: Grafiken nicht löschen

15.03.2025 11:05:51

volti

Ein Vorschlag:

Alle Objekte, die bleiben sollen, in einmaliger Aktion umbenennen.....

Sub Test()

  For Each Shp In ActiveSheet.Shapes

      If Not Shp.Name Like "Bleibt*" Then Shp.Delete ' Lösche das Shape

  Next Shp

End Sub



Sub Umbenennen()

' Objekt markieren und code laufen lassen

  Selection.Name = "Bleibt1"

End Sub

Gruß KH

AW: Grafiken nicht löschen

15.03.2025 11:10:44

volti

Zur Ergänzung:

Jedes Objekt soll am besten einen anderen Namen bekommen, der nur am Anfang gleich ist

Bleibt1
BleibtGrafik2
BleibtLinie5

usw.

Forumthread: Grafiken nicht löschen

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

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread