Office: Laufzeitfehler '-2147221040(800401d0)' Die Methode 'Copy'...

GreenEagle · 1. August 2020

Hallo Leute,

ich habe schon länger ein Problem in einem sehr großen VBA-Makro beim kopieren von Diagrammen. In der Zeile "objDia.Copy" kommt sporadisch die Fehlermeldung:

Laufzeitfehler '-2147221040(800401d0)':
Die Methode 'Copy' für das Objekt 'ChartObject' ist fehlgeschlagen

Ich habe die Problemstellung zum Testen nachgebaut.
Man kann den Code einfach in ein Modul kopieren und über das erste Sub "TestAufbau" die Testumgebung aufbauen.

Durch starten den 2.Sub's "TestCopyChart" kann man den Fehler provozieren.

Das 2.Sub kopiert durch 2 Schleifen nacheinander 20.000 mal das Diagramm in die Zwischenablage. Das Makro würde ohne Fehler ca. 1,5 min. laufen.
Sporadisch hängt sich das Makro in der Schleife auf.

Ich habe das ganze unter verschiedenen Betriebssystemem und ExcelVersionen getestet.

Windows 10 64 Bit, RAM 8 GB Excel 2016 64Bit -> Fehlermeldung nach ca. 8.000 -15.000 x Copy
Windows 10 64 Bit, RAM 8 GB Excel 2016 32Bit -> Fehlermeldung nach ca. 32-150 x Copy
Windows 7 64 Bit, RAM 16 GB Excel 2007 32Bit -> Keine Fehlermeldung ! Makro läuft erfolgreich durch

Code:

Option Explicit

Sub TestAufbau()
'Tabellenblatt und leeres Diagramm erzeugen
Dim WB As Workbook
Dim B As Worksheet
Dim objDia As ChartObject

Set WB = ThisWorkbook
WB.ActiveSheet.Name = "B"
Set B = WB.Sheets("B")
Set objDia = B.ChartObjects.Add(100, 100, 300, 200)
objDia.Name = "Diagramm"
End Sub

Sub TestCopyChart()

'Achtung, PC könnte abstürzen
Dim WB As Workbook
Dim B As Worksheet
Dim objDia As ChartObject
Dim r, k As Long
Dim t As Date

Set WB = ThisWorkbook
Set B = WB.Sheets("B")
Set objDia = B.ChartObjects("Diagramm")

For k = 1 To 20
For r = 1 To 1000
objDia.Copy
Next
Next

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kennt jemand diesen VBA-Bug ?

Neben der Frage wie man das Problem zuverlässig in den Griff bekommt interessiert mich vorallem warum der Fehler auftritt. Ich vermute, dass im Hintergrund ein Prozess oder eine Auslagerungsdatei "überläuft".

Meine Versuche bis jetzt um das Problem zu lösen:
- ClearClipboard über API
- DoEvents
- Application.wait (time + timeValue ("00:00:01"))
- Sleep über API
- Copy auslagern in Routine

Erfolg bis jetzt: sehr mäßig! Die Wait-Methode bringt ein bisschen was aber die Laufzeit ist leider viel hoch.

Das Makro ist natürlich nur ein Nachbau des fehlerhaften Bereiches. Im richtigen Makro folgt auf den ChartObject.copy Befehl ein Past-Befehl.

Danke für eure Hilfe!

:)

xlph 2.0 · 3. August 2020

Hallo,

verwende Duplicate:

Code:

Sub TestDuplicateChart()

'Achtung, PC könnte abstürzen
Dim WB As Workbook
Dim B As Worksheet
Dim objDia As ChartObject
Dim objNew As Shape
Dim r, k As Long
Dim t As Date

Set WB = ThisWorkbook
Set B = WB.Sheets("B")
Set objDia = B.ChartObjects("Diagramm")

Application.ScreenUpdating = False
For k = 1 To 20
For r = 1 To 1000
Set objNew = objDia.Duplicate
Next
Next
Application.ScreenUpdating = True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

GreenEagle · 5. August 2020

Jawoll! Vielen Dank, xlph 2.0 !

Dublicate! *cool.gif*

Die Kombination von "Dublicate" und "Location" läuft äußerst stabil und ersetzt das fehleranfällige Copy und Past!

Ich habe den Versuchsaufbau angepasst. Läuft wie ein Uhrwerk!
Code:

Option Explicit

Sub TestAufbau()
Dim WB As Workbook
Dim B, C As Worksheet
Dim objDia As ChartObject

Set WB = ThisWorkbook
WB.ActiveSheet.Name = "B"
Set B = WB.Sheets("B")
Set C = WB.Worksheets.Add(After:=WB.Sheets("B"))
C.Name = "C"
Set objDia = B.ChartObjects.Add(100, 100, 300, 200)
objDia.Name = "Diagramm"
End Sub

Sub Test_Dublicate_Location_V2()
Dim WB As Workbook
Dim B, C As Worksheet
Dim objDia As ChartObject
Dim objNew As Shape
Dim k, r As Long

Set WB = ThisWorkbook
Set B = WB.Sheets("B")
Set C = WB.Sheets("C")
Set objDia = B.ChartObjects("Diagramm")

For k = 1 To 5
Application.ScreenUpdating = False
For r = 1 To 400 'Laufzeit ca. 4 Min.
Set objNew = objDia.Duplicate
objNew.Name = "Test"
objNew.Chart.Location xlLocationAsObject, "C"
Set objNew = C.Shapes("Test")
objNew.Delete
Next
Application.ScreenUpdating = True
Debug.Print k * (r - 1) & vbTab & Now
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Laufzeitfehler '-2147221040(800401d0)' Die Methode 'Copy'...

Laufzeitfehler '-2147221040(800401d0)' Die Methode 'Copy'...

Laufzeitfehler '-2147221040(800401d0)' Die Methode 'Copy'...

Laufzeitfehler '-2147221040(800401d0)' Die Methode 'Copy'... - Similar Threads - Laufzeitfehler 2147221040 800401d0

Laufzeitfehler 9 VBA

VBA Laufzeitfehler 9

[VBA] .Documents.Open -> Laufzeitfehler 91

MS Access Lauftzeitfehler "2501"

Excel VBA Laufzeitfehler 424 Objekt erforderlich

Laufzeitfehler "424" Objekt erforderlich Selenium VBA

Laufzeitfehler 1004 "Die Methode 'Range' für das Objekt '_Global' ist fehlgeschlagen".