Laufzeitfehler 1004
04.11.2020 13:06:10
Spitzbube
bei folgendem Makro bekomme ich immer den Laufzeitfehler "1004:CopyPicture-Methode kann nicht ausgeführt werden". Dies passiert immer bei dem "Paste"-Befehl und immer an einer unterschiedlichen Stelle. Kann jemand helfen?
Option Explicit
Public objWordRange As Object
Public objDocument As Object
Public objDialog As Object
Public objApp As Object
Public strVorlage As String
Public Bkmrk As Object
Public Name As String
Public AnlageEingangKorrekturwerte As Integer
Public Name As String
Sub CreateDocument()
AnlageEingangKorrekturwerte = Sheets("Basisdaten").Range("Anlage_Eingangsdaten_Korrektur")
If Sheets("Basisdaten").Range("Status") = "intern" Then
strVorlage = "hier mein Pfad"
Else
strVorlage = "hier der andere Pfad"
End If
Set objApp = CreateObject("Word.Application")
objApp.Visible = True
Set objDocument = objApp.Documents.Add(Template:=strVorlage)
If AnlageEingangKorrekturwerte = 1 Then
Call Eingang_Korrekturwerte_Subroutine
End If
With objApp
Name = "mein Speicherpfad"
.ActiveDocument.SaveAs Filename:=Name
.ActiveDocument.Close
End With
objApp.Quit
Set objApp = Nothing
End Sub
Unterprogramm:
Sub Eingang_Korrekturwerte_Subroutine()
With ThisWorkbook.Worksheets("Korrektur")
If Sheets("Korrektur").Range("Korrektur_Gewinn_Abfrage") = 1 Then
If objDocument.Bookmarks.Exists("Korrektur_Gewinn") = True Then
.Range("Korrektur_Gewinn").CopyPicture 1, 2
Set objWordRange = objDocument.Bookmarks("Korrektur_Gewinn").Range
objWordRange.Paste
Set objWordRange = Nothing
End If
End If
If Sheets("Korrektur").Range("Korrektur_Gewinn_Abfrage2") = 1 Then
If objDocument.Bookmarks.Exists("Korrektur_Gewinn2") = True Then
.Range("Korrektur_Gewinn2").CopyPicture 1, 2
Set objWordRange = objDocument.Bookmarks("Korrektur_Gewinn2").Range
objWordRange.Paste
Set objWordRange = Nothing
End If
End If
If Sheets("Korrektur").Range("Korrektur_Gewinn_Abfrage3") = 1 Then
If objDocument.Bookmarks.Exists("Korrektur_Gewinn3") = True Then
.Range("Korrektur_Gewinn3").CopyPicture 1, 2
Set objWordRange = objDocument.Bookmarks("Korrektur_Gewinn3").Range
objWordRange.Paste
Set objWordRange = Nothing
End If
End If
End With
End Sub