---

Hallo,

ich habe eine Tabelle bekommen, in der leider unendlich viele (300) Wordart Texte übereinander gelagert sind  . Gibt es eine Möglichkeit, alle Wordart Texte auf einmal zu löschen? Das laden und bearbeiten der Datei ist unerträglich. Weiß gar nicht wie man sowas verbrechen kann

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

versuche das mal so.

CU, Bernd
--

Code:

---

Option Explicit

Sub x()
  Dim i As Integer
 
  For i = ActiveSheet.Shapes.Count To 1 Step -1
      If TypeName(ActiveSheet.Shapes(i).OLEFormat.Object) = "Rectangle" Then ActiveSheet.Shapes(i).Delete
  Next
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,
wirklich alle löschen? Ohne wenn und aber?
Dann vielleicht so:

Code:

---

Option Explicit
Sub DeleteWordArt()
Dim obj As Object
For Each obj In Sheets(1).Shapes
    If obj.Type = msoTextEffect Then
        obj.delete
    End If
Next obj
End Sub

---

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hat funktioniert - Besten Dank! Waren allerdings mehrere Blätter, so dass ich das Makro für jedes Blatt einzeln durchlaufen lassen musste. Geht bestimmt auch einfacher, aber dafür bin ich zu doof 
Das Makro von runkelrube konnte ich allerdings nur auf dem ersten Blatt anwenden. 
Aber Üs sind unterwegs

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von Peterpaul:
[...]
Das Makro von runkelrube konnte ich allerdings nur auf dem ersten Blatt anwenden. [...]

---

Ja, ich dachte, man setzt sich auch ein wenig damit auseinander, was man per copy&paste einfügt... 
das liegt daran: For Each obj In Sheets(1).Shapes
änder den Index, dann machst Du es im anderen Blatt.
Oder pack ne Schleife drum rum:

Code:

---

Sub DeleteWordArt()
Dim obj As Object, a%
For a = 1 To ThisWorkbook.Sheets.Count
For Each obj In Sheets(a).Shapes
    If obj.Type = msoTextEffect Then
        obj.Delete
    End If
Next obj
Next a
End Sub

---

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Das mit der Zahl ändern hatte ich schon probiert- Schleife kannte ich nicht 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP