Excel – sehr viele unsichtbare Squares

Eine Excel-Tabelle lädt sehr langsam, speichert sehr langsam, und ist generell zäh in der Bedienung. Beim wilden rumklicken fällt auf, dass hier und da weiße Vierecke sind; vergleichbar mit dem auf der rechten Seite.

Wie das Problem zu Stande kommt ist unbekannt, kam aber hier schon ein paar mal vor. Ich vermute, dass es mit einer Drittanbietersoftware (OpenOffice etc.) zusammenhängt; aber keine Ahnung, ob dem so ist.

Um das Problem zu lösen, nutzen wir ein VBA-Script. Wir starten die VBA-Umgebung, indem wir ALT+F11 gleichzeitig drücken.

In dem neuen Fenster Einfügen > Modul

Dann den Code unter dem Bild einfügen:

Folgender Code:

Sub DeleteAllElements()
	Dim CurrentElem As Object
	For Each CurrentElem In ActiveSheet.Pictures
		CurrentElem.Delete
		DoEvents
	Next CurrentElem
	MsgBox "Alle gelöscht", vbOKOnly
End Sub

Taste F5 drücken, um das auszuführen.

In dem Code das Pictures noch mal durch Shapes ersetzen und wieder ausführen:

Sub DeleteAllElements()
	Dim CurrentElem As Object
	For Each CurrentElem In ActiveSheet.Shapes
		CurrentElem.Delete
		DoEvents
	Next CurrentElem
	MsgBox "Alle gelöscht", vbOKOnly
End Sub

Nachdem die Nachricht kommt, dass alle gelöscht wurden, muss das Modul wieder rausgelöscht werden. Dazu im linken Dateibaum unter Module > Modul1 Rechtsklick > Modul löschen.

Die Datei kann nun ohne Shapes gespeichert werden.

Wenn es zu langsam ist

Ich habe mich später an folgenden Code gesetzt, weil das sehr langsam bei mir lief:

Sub DeleteAllElements()
	Dim CurrentElem As Object
	Dim RefreshCounter As Integer
	Dim GeneralCounter As Integer
	RefreshCounter = 0
	GeneralCounter = 0
	Application.ScreenUpdating = False
	Application.Calculation = xlCalculationManual
	Application.EnableEvents = False
	Application.DisplayStatusBar = True 
	Application.StatusBar = "Lese Objekte..." 
	For Each CurrentElem In ActiveSheet.Shapes
		CurrentElem.Delete
		RefreshCounter = RefreshCounter + 1
		If RefreshCounter = 100 Then
			DoEvents
			RefreshCounter = 0
		End If
		GeneralCounter = GeneralCounter + 1
		Application.StatusBar = "Gelöscht: "& GeneralCounter &" 
	Next CurrentElem
	Application.ScreenUpdating = True
	Application.Calculation = xlCalculationAutomatic
	Application.EnableEvents = True
	MsgBox "Alle gelöscht", vbOKOnly
End Sub

Der schafft mit den Anpassungen und Prozess-Prio = Hoch ca. 1.000 Shapes pro Sekunde zu löschen, stürzt allerdings dafür gerne mal ab – und muss häufiger gestartet werden.

Kategorie: Office

tino-ruge.de wird tino-kuptz.de

Im Laufe des Jahres 2024 wird dieser Blog umziehen. Alle Inhalte werden 1:1 weitergeleitet, nix geht verloren. Neue Domain, alter Autor, alter Inhalt.