Office: Laufzeitfehler 1004 mit Paste-Methode

hi@ · 15. Juli 2018

Hallo zusammen,

ich hoffe ihr könnt mir bei meinem Problem weiterhelfen, mittlerweile habe ich alles versucht, was mir einfällt, aber ich kriege mein Programm einfach nicht zum laufen ... wenn ich den Code im Einzelschritt durchklicke, dann funktioniert alles wunderbar.
Wenn ich die Excel-Datei starte und den Code wie gewollt über das Workbooks_Open() Even starte, dann kommt immer zu einem willkürlichen Zeitpunkt entweder der Fehler
"Laufzeitfehler '1004': Die Paste-Methode des Worksheet-Objektes konnte nicht ausgeführt werden."

oder

"Laufzeitfehler '1004': Microsoft kann die Daten nicht einfügen".

Das Programm ist nicht sonderlich schwer.

Es liegen 7 identische Excel Dateien im .xlsx Format in einem Ordner. Im gleichen Ordner liegt eine weitere Datei, die den Programm-Code enthält und beim starten den Code ausführt.
Jede einzelne .xlsx Datei wird geöffnet und aus verschiedenen Tabellenblättern werden unterschiedliche Bereiche als Screenshot kopiert und in die Programm Datei eingefügt.
Nachdem alles kopiert ist, wird ein Bereich markiert, der als PDF exportiert wird. Anschließend werden alle kopierten Screenshots gelöscht und die nächste Datei eingeladen. Wie gesagt, im Einzelschritt läuft alles, aber sonst bekomme ich immer diesen Fehler, zu irgendeinem Zeitpunkt. Was stimmt nicht mit dem Code?

Hier der Code:
Code:

Option Explicit

Sub Workbook_Open()

Application.ScreenUpdating = False

'Quelldatei
Dim SourceName As String

'Datei Einstellungen
Dim fPath As String 'Datei Pfad
Dim fPattern As String 'Datei Muster
Dim fActual As String 'Aktuell bearbeitete Datei
Dim fSheetCount As Integer 'Gesamtanzahl der Tabellenblätter
Dim fSheetActual As Integer 'Aktuelles Tabellenblatt
Dim fCounter As Integer 'Zählvariable für Dateien
Dim pSteps As Integer 'Anzahl der Druck Steps
Dim fReport As Integer 'Reports erstellen ja(1)/nein(0)
Dim fName As String

'Screenshots Zeilen/Spalten Definitionen
Dim rG As Integer
Dim rD As Integer
Dim rV As Integer
Dim rS As Integer
Dim rP As Integer

Dim cG As Integer
Dim cD As Integer
Dim cV As Integer
Dim cS As Integer
Dim cP As Integer

Dim rVar As Integer
Dim rB As Integer
Dim rNP As Integer
Dim rNP2 As Integer

rG = 15
rD = 25
rV = 11
rS = 28
rP = 45

rVar = 1
cG = 3
cD = 4
cV = 4
cS = 4
cP = 2

'Platz zwischen Screenshots etc.
rB = 5
rNP = 14
rNP2 = 10

'Name der Quell-Datei
SourceName = ThisWorkbook.Name

'Anzahl der Dateien im Ordner bestimmen
fPattern = "*.xlsx"
fPath = ThisWorkbook.Path & ""
fActual = Dir(fPath & fPattern, vbDirectory)

pSteps = 5

Do While fActual ""
fActual = Dir
fCounter = fCounter + 1

Loop

fReport = 0

If fCounter > 0 Then
If MsgBox(fCounter & " new Test Reports available - generate PDF file?", vbYesNo) = vbYes Then
fReport = 1

Else
MsgBox "Report canceled"
Exit Sub

End If

Else
MsgBox "No new reports available"

End If

If fReport = 1 Then
fSheetActual = 1
fActual = Dir(fPath & fPattern, vbDirectory)

Do While fActual ""

Application.DisplayAlerts = False
Workbooks.Open Filename:=fPath & fActual
fSheetCount = Workbooks(fActual).Worksheets.Count

For fSheetActual = 1 To fSheetCount - pSteps

If Workbooks(fActual).Worksheets(fSheetActual).Name = "General Information" Then
'General Information
Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A1:M15").CopyPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cG)

End With

rVar = rVar + rG + rB

ElseIf Workbooks(fActual).Worksheets(fSheetActual).Name = "Pass Criteria" Then
'Pass Criteria

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A1:W44").CopyPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cP)

End With

rVar = rVar + rP + rB

ElseIf Workbooks(fActual).Worksheets(fSheetActual).Name = "Pump Characteristic" Then
'Visualization

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A1:M8").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cV)

End With

rVar = rVar + rV + rB

'Diagramme
Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A10:M40").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cD)

End With

rVar = rVar + rD + rB

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A43:M73").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cD)

End With

rVar = rVar + rD + rB + rNP

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A76:M106").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cD)

End With

rVar = rVar + rD + rB

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A109:M139").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cD)

End With

rVar = rVar + rD + rB

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A142:M172").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cD)

End With

rVar = rVar + rD + rB

Workbooks(fActual).Worksheets(fSheetActual).Activate
Application.Range("A175:M205").CopyPicture xlScreen, xlPicture

With Workbooks(SourceName).Worksheets(1)
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cD)

End With

rVar = rVar + rD + rNP2 + rB

End If

Next

'PDF Druck

fName = Workbooks(fActual).Name
Workbooks(fActual).Close savechanges:=False

Workbooks(SourceName).Worksheets(1).Activate
Workbooks(SourceName).Worksheets(1).Range("A1:Y290").Select

With Workbooks(SourceName).Worksheets(1).PageSetup
.Zoom = False
.PaperSize = xlPaperA4
.FitToPagesWide = 1
.FitToPagesTall = False
.BlackAndWhite = False
End With

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=(fPath & Left(fName, (Len(fName) - 5))), _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

Workbooks(SourceName).Worksheets(1).Activate
ActiveSheet.Pictures.Delete
rVar = 1

fActual = Dir

Loop

End If

If fReport = 1 Then

MsgBox "Report generation finished!" & vbNewLine & vbNewLine & _
"New reports: " & fCounter

End If

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

:)

R J · 17. Juli 2018

Hi hi,

welche Stelle des Codes markiert denn der Debugger?
Kleiner Hinweis, wie Du den Fehler selbst finden kannst, überprüfe, welche Werte Deine Variablen an der Fehlerstelle haben. Der eigentliche Fehler ist dann meist irgendwo davor zu finden.

hi@ · 17. Juli 2018

Hallo,

Diese Stelle wird markiert, also das erste Bild, das eingefügt werden soll.

.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cG)

Das lustige ist, dass wenn ich im Debugger bin und Einzelschritt klicke, der Code funktioniert. Der Fehler tritt nicht wieder auf.

Ich mache alles nochmal zu, starte den Code wieder. Diesmal wird der folgende Code gelb unterlegt:

.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cV)

Also das dritte bild. Wieder das gleiche Spiel - klicke ich auf F8 läut der Code durch, ich bekomme keinen Fehler.

Ich werde daraus einfach nicht schlau...

MisterBurns · 17. Juli 2018

Wage mal einen Versuch mit

Code:

With Workbooks(SourceName).Worksheets(1)
.Activate
.Paste Destination:=Workbooks(SourceName).Worksheets(1).Cells(rVar, cG)

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

R J · 17. Juli 2018

...ich überprüfe jetzt nicht alle Vorkommen von rVar, aber mach aus dem Integer mal ein Long und lass Dir mal die Werte ausgeben....

hi@ · 17. Juli 2018

Danke für die Tipps, werde das mal ausprobieren.
rVar nimmt maximal den Wert 290 an und wird nach jeder Datei wieder auf 1 gesetzt, aber ich setze auch diesen Tipp eben um und melde mich dann.

Edit:
Eure Vorschläge haben das Problem leider nicht behoben.
Der Fehler taucht auf, ich öffne den Debugger, setzte das Programm manuell fort und es läuft wieder kurz, dann wieder manuell fortsetzen, bis das Programm durchgelaufen ist.

Gruß

Luschi · 17. Juli 2018

Hallo hi@,

Du scheuchst den Vba-Code durch die Manage, ohne zu wissen, ob die vorhergehende Aktion abgeschlossen ist, deshalb sieht das bei mir so aus:
'Zwischenablage löschen
Application.CutCopyMode = False
DoEvents
Application.Range("A1:M15").CopyPicture
DoEvents
'und jetzt kann's weitergehen

Gruß von Luschi
aus klein-Paris

PS: das Problem dabei - CopyPicture ist noch nicht fertig, da willst Du aber schon das Ergebnis aus der Zwischenablage holen.

Noch eine Frage: warum fActual = Dir(fPath & fPattern, vbDirectory) und nicht
fActual = Dir(fPath & fPattern, vbNormal)?

hi@ · 17. Juli 2018

Hallo Luschi,

ich habe deinen Tipp umgesetzt und es läuft wunderbar, vielen Dank dafür!!*Smilie

Um ehrlich zu sein habe ich den dir Befehl mit vbDirectory einfach aus dem Netz übernommen und weiß nicht, wo genau der Unterschied zwischen vbDirectory und vbNormal liegt. Habe mal jetzt vbNormal hingeschrieben - was bewirkt das?

Viele Grüße

Office: Laufzeitfehler 1004 mit Paste-Methode

Laufzeitfehler 1004 mit Paste-Methode

Laufzeitfehler 1004 mit Paste-Methode

Laufzeitfehler 1004 mit Paste-Methode

Laufzeitfehler 1004 mit Paste-Methode

Laufzeitfehler 1004 mit Paste-Methode - Similar Threads - Laufzeitfehler 1004 Paste

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

Laufzeitfehler 5 und 1004

FormulaArray / Laufzeitfehler 1004

Laufzeitfehler 1004 bei Copy Paste

Laufzeitfehler 1004

Probleme bei Speichern laufzeitfehler 1004

Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler