Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1072to1076
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
1072to1076
1072to1076
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Grafiken aus Zellen löschen

Grafiken aus Zellen löschen
04.05.2009 12:11:58
Knusperfisch
Hallo nochmal,
ich habe eine Tabelle die mit Daten aus einer anderen Datei gefüttert wird, leider kopieren sich hunderte, wenn nicht tausende Million Milliarden an kleinen Grafiken (sehen wie Hyperlinks aus) in die Zellen mit hinein und irgendwann sind die Zellen überfüllt und man erkennt nüscht mehr. Wie kann ich entweder verhindern, dass diese Grafiken in meine Tabelle kopiert werden, oder aber wie ich sie hinterher per Makro oder VBA wieder löschen kann. Die nerven wirklich sehr.
Bäääästen Dank

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
VBA Makro
04.05.2009 12:22:32
Tino
Hallo,
hier mal ein Makro zum löschen.
Den Namen der Tabelle im Code noch anpassen.
Sub Beispiel()
Dim myAr() As String
Dim A As Long
Dim objShap As Shape

With Sheets("Tabelle1") 'Tabellenname anpassen 
    
    For Each objShap In .Shapes
     If objShap.Type = msoPicture Then
      Redim Preserve myAr(A)
      myAr(A) = objShap.Name
      A = A + 1
     End If
    Next objShap

    .Shapes.Range(myAr).Delete

End With
End Sub


Gruß Tino

Anzeige
AW: VBA Makro
04.05.2009 12:43:57
{Boris}
Hi Tino,
das hast Du aber nicht getestet ;-)
Grüße Boris
AW: doch habe ich...
04.05.2009 12:54:47
Knusperfisch
dumme Frage dazu: Wie muss ich das abändern, damit es für alle Tabellenblätter meiner Datei funktioniert (bisher bezieht es sich ja nur auf ein Tabellenblatt) ?
AW: doch habe ich...
04.05.2009 13:07:33
Tino
Hallo,
für alle Tabellen müsste es so gehen.

Sub Beispiel()
Dim myAr() As String
Dim A As Long
Dim objShap As Shape
Dim mySH As Worksheet
For Each mySH In ThisWorkbook.Worksheets
With mySH
A = 0: Erase myAr
For Each objShap In .Shapes
If objShap.Type = msoPicture Then
ReDim Preserve myAr(A)
myAr(A) = objShap.Name
A = A + 1
End If
Next objShap
.Shapes.Range(myAr).Delete
'.Shapes.Range(Application.Transpose(myAr)).Delete 'oder diese bei xl2003
End With
Next mySH
End Sub


Eventuell muss unter xl2003 aus der Zeile
.Shapes.Range(myAr).Delete
diese gemacht werden.
.Shapes.Range(Application.Transpose(myAr)).Delete

Anzeige
kann höchstens sein...
04.05.2009 13:01:07
Tino
Hallo,
..., dass mein Excel (xl2007) da nicht so kleinlich ist.
Ersetze mal die Zeile
.Shapes.Range(myAr).Delete
Durch diese
.Shapes.Range(Application.Transpose(myAr)).Delete
Gruß Tino
AW: kann höchstens sein...
04.05.2009 13:07:52
Knusperfisch
ich bekomm laufend die Meldung, dass der Index ausserhalb des gültigen Bereichts liegt (Laufzeitfehler 9)
AW: kann höchstens sein...
04.05.2009 13:16:44
Tino
Hallo,
dann sind auf manschen Tabellen keine Grafiken.
Hier mit Prüfung.

Sub Beispiel()
Dim myAr() As String
Dim A As Long
Dim objShap As Shape
Dim mySH As Worksheet
For Each mySH In ThisWorkbook.Worksheets
With mySH
A = 0: Erase myAr
For Each objShap In .Shapes
If objShap.Type = msoPicture Then
ReDim Preserve myAr(A)
myAr(A) = objShap.Name
A = A + 1
End If
Next objShap
If A > 0 Then
'        .Shapes.Range(myAr).Delete 'oder diese bei xl2007
.Shapes.Range(Application.Transpose(myAr)).Delete 'oder diese bei xl2003
End If
End With
Next mySH
End Sub


Gruß Tino

Anzeige
AW: kann höchstens sein...
04.05.2009 13:23:53
Knusperfisch
nun ist zwar der Fehler verschwunden, die Grafiken sind allerdings geblieben.
AW: kann höchstens sein...
04.05.2009 13:32:38
Tino
Hallo,
dann sind es keine Grafiken, lade mal ein Beispiel hoch mit wenigstens einen Objekt.
Gruß Tino
hier noch eine Version.
04.05.2009 14:03:33
Tino
Hallo,
diese hat aber den Nachteil, diese kickt alle Objekte raus, also auch Button, Textboxen usw.…
Sub Beispiel()
Dim objShap As Shape
Dim mySH As Worksheet

For Each mySH In ThisWorkbook.Worksheets
     With mySH
        If mySH.Shapes.Count > 0 Then
            mySH.DrawingObjects.Delete
        End If
     End With
Next mySH

End Sub


Gruß Tino

Anzeige
für xl2003 und 2007
04.05.2009 13:27:44
Tino
Hallo,
hier noch eine die auf beiden Versionen geht.
Sub Beispiel()
Dim myAr() As String
Dim A As Long
Dim objShap As Shape
Dim mySH As Worksheet

For Each mySH In ThisWorkbook.Worksheets
     With mySH
        A = 0: Erase myAr
        For Each objShap In .Shapes
         If objShap.Type = msoPicture Then
          Redim Preserve myAr(A)
          myAr(A) = objShap.Name
          A = A + 1
         End If
        Next objShap
    
       If A > 0 Then
        If CSng(Application.Version) > 11 Then
          .Shapes.Range(myAr).Delete 'oder diese bei xl2007 
        Else
          .Shapes.Range(Application.Transpose(myAr)).Delete 'oder diese bei xl2003 
        End If
       End If
      
      End With
Next mySH
End Sub


Gruß Tino

Anzeige

Links zu Excel-Dialogen

TextBox

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige