Office: alle Shapes entfernen

Hallo zusammen,

ich bräuchte mal Eure Hilfe um ein Makro zu erstellen.
Ich kopiere regelmäßig das Ergebnis aus einer Business Explorer Abfrage (SAP BW 3.x) in meine Excel-Datei (nur die fixen Werte, aber auch mit allen Formaten). Dabei werden leider auch die kleinen Auf- und Zu-Klappdreiecke (Shapes?) mit kopiert. Diese funktionieren natürlich nicht mehr in Excel, stören also nur.
Ich möchte diese also nun alle entfernen (dürften tausende sein).
Mein Makrorecorder nimmt folgenden Code dazu auf:

PHP:

         ActiveSheet.Shapes("BEx00O4P2D6MZMZCFHUR6HPOAALR").Select
Selection.Delete


:)

 

Hi,

Code:

das löscht alle Shapes

 

Moin
probier mal.
Code:

Edit;oder
Code:

gruss hary

 

Hallo Ingo,

schau mal, ob der Code tut, was er soll:

PHP:

         Sub alle_weg()
Dim sp As Shape
For Each sp In ActiveSheet.Shapes
sp.Delete
Next sp
End Sub


 

Hallo Chris, hary und David,

Ihr seid der Hammer. Gleich 3 Lösungen.
Ich habe Davids Code ausprobiert und der ist einfach der Wahnsinn und erfüllt schon meine Anforderung.
Der läuft über 5 Minuten, soviele Shapes waren darin!

Eine Bitte hätte ich aber noch:
Ich wußte nicht das dies stören könnte. Ich habe einen Filter in diesem Datenblatt und der wird nun auch einzeln weggelöscht. Ist es möglich dies auszuschließen?
Wenn nicht ist es auch kein Problem, ich kann ihn ja per Hand vorher löschen und nachher wieder neu setzen.
Oder löst dieses Problem der Code von hary, den ich noch nicht ausprobieren konnte (ich wollte mich zuerst einmal bei Euch bedanken)?

Also viiiiiiiiiiiiiiiiiiiieeeeeeeeeeeeelllllllllllllllllleeeeeeennnnnnnn lieben Dank
Euer Ingo

 

Moin Ingo

Duerfte von den Codes nicht angeruehrt werden.
Evtl. Bsp.-Mappe mit Filter hochladen.

Dann probier doch mal meinen.
gruss hary

 

Hallo hary,

Du hast mit beidem Recht.
Ich habe Deinen ersten Code getestet:
Der Filter bleibt unberührt. Genial!
Der Code läuft 1 Sekunde.....einfach hammerhart!!!

Kleines neues Problem: Ich habe, naiv wie ich bin, eine Schaltfläche zum Starten Deines Makros in dieses Datenblatt gebaut. Konsequent wie Dein Code nun einmal ist, wird auch diese Schaltfläche gelöscht.
Gibt es eine Möglichkeit zu sagen, "lösche alle Shapes ausser Schaltfläche 19969"?

LG Ingo

P.S.: toller positiver Effekt: Meine Datei ist nun 3 MB kleiner (anstatt 15 MB nur noch 12 MB)!!!

 

Hi Ingo,

jetzt wird mein code wieder interessant *wink.gif*

PHP:

         Sub alle_weg()
Dim sp As Shape
application.screenupdating=false
For Each sp In ActiveSheet.Shapes
if mid(sp.name,1,2)="BE" then sp.Delete
Next sp
application.screenupdating=true
End Sub


 

Hallo Ingo,

der Vorteil bei DrawingObjects
ist eben das gleich alles gelöscht wird.

Wenn Du willst baue ich Dir ein Add-in das gleich alles löscht, mit einem eigenen Menüpunkt. Dann wird der Button nicht benötigt.

ODER soll ich etwas bauen das nur "Bildchen" löscht und Kommentare, Charts Butons usw. auf dem Blatt belässt?(das dauernd dann halt bei der Ausführung)

Am Besten auch gleich als Add-in.

*wink.gif*

 

Hallo David,

ja in der Tat, jetzt wird Dein Code wieder interessant.
Ich habe ihn getestet und meine Wünsche werden damit nun fast alle erfüllt.
Nur leider dauert es Minuten.
Nun muss ich überlegen was einfacher geht.

@chris:
Vielleicht ist es einfacher, den Code von hary zu nehmen, und diesem Code anschließend zu sagen, nun baue eine neue Schaltfläche in die Celle H13 die mit diesem Makro verknüpft wird und den Namen "alle Shapes entfernen" erhält.
Geht das? Oder entsteht dadurch so etwas wie ein Zirkelbezug?

Aber weiterhin vielen Dank an alle hier im Thread, die mir so toll helfen. Ich komme gar nicht schnell genug hinterher alles zu testen.
Und mit allen Lösungen könnte ich leben. Nun arbeite ich nur noch am "Feintuning".

LG Ingo

 

Hi,

ich habe mal alle Shapes entfernen in ein Add-in gepackt.

Datei extrahieren -> In Excel -> Extras -> Add-ins -> Durchsuchen und die Datei wählen. Rest ist dann selbsterklärend.
Du hast dann eine neue Schaltfläche in der Menübar.

 

Hallo Chris,

mit Add-ins habe ich bisher noch nicht gearbeitet.
Aber Dein Add-in funktioniert bestens.


Vielen lieben Dank
und Grüße aus Köln
Ingo

P.S.: In der übernächsten Woche mache ich die österreichischen Berge unsicher *grins

 

Hallo Ingo,

wie war es denn gewesen in den Bergen Österreichs?
Ich planen selbst einen Trip auf den Watzmann.
Lohnt es sich?

PS: Habe mir gestern einen neuen Smart TV gegönnt *grins :supergrins:

IngoPower!