Laufzeitfehler 1004
01.02.2017 17:13:35
Dennis
mein erster Beitrag hierzu ist folgender:
⇒ https://www.herber.de/forum/archiv/1532to1536/t1534490.htm
⇐
Ich habe folgenden Code (danke an Werner):
Sub MA01Mail()
Dim Nachricht As Object, OutApp As Object
Dim AWS As String
Application.ScreenUpdating = False 'Bildschirmaktualisierug ausschalten
Application.DisplayAlerts = False 'Fehlermeldungen ausschalten
Titel = Sheets(1).Range("A8").Value
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 'neues Blatt am Ende der _
Tabelle
Sheets(Worksheets.Count).Name = Titel
'Januar Kopieren
Application.CutCopyMode = False
Sheets("Januar").Range("A2:AF5").Copy Sheets(Titel).Range("A1")
Sheets("Januar").Range("A8:AF9").Copy Sheets(Titel).Range("A5")
'Februar Kopieren
Sheets("Februar").Range("B2:AF5").Copy Sheets(Titel).Range("B8")
Sheets("Februar").Range("A8:AF9").Copy Sheets(Titel).Range("A12")
'März Kopieren
Sheets("März").Range("B2:AF5").Copy Sheets(Titel).Range("B15")
Sheets("März").Range("A8:AF9").Copy Sheets(Titel).Range("A19")
'April Kopieren
Sheets("April").Range("B2:AF5").Copy Sheets(Titel).Range("B22")
Sheets("April").Range("A8:AF9").Copy Sheets(Titel).Range("A26")
'Mai Kopieren
Sheets("Mai").Range("B2:AF5").Copy Sheets(Titel).Range("B29")
Sheets("Mai").Range("A8:AF9").Copy Sheets(Titel).Range("A33")
'Juni Kopieren
Sheets("Juni").Range("B2:AF5").Copy Sheets(Titel).Range("B36")
Sheets("Juni").Range("A8:AF9").Copy Sheets(Titel).Range("A40")
'Juli Kopieren
Sheets("Juli").Range("B2:AF5").Copy Sheets(Titel).Range("B43")
Sheets("Juli").Range("A8:AF9").Copy Sheets(Titel).Range("A47")
'August Kopieren
Sheets("August").Range("B2:AF5").Copy Sheets(Titel).Range("B50")
Sheets("August").Range("A8:AF9").Copy Sheets(Titel).Range("A54")
'September Kopieren
Sheets("September").Range("B2:AF5").Copy Sheets(Titel).Range("B57")
Sheets("September").Range("A8:AF9").Copy Sheets(Titel).Range("A61")
'Oktober Kopieren
Sheets("Oktober").Range("B2:AF5").Copy Sheets(Titel).Range("B64")
Sheets("Oktober").Range("A8:AF9").Copy Sheets(Titel).Range("A68")
'November Kopieren
Sheets("November").Range("B2:AF5").Copy Sheets(Titel).Range("B71")
Sheets("November").Range("A8:AF9").Copy Sheets(Titel).Range("A75")
'Dezember Kopieren
Sheets("Dezember").Range("B2:AF5").Copy Sheets(Titel).Range("B78")
Sheets("Dezember").Range("A8:AF9").Copy Sheets(Titel).Range("A82")
'Zellen Anpassen
Columns("A").AutoFit
Columns("B:AG").ColumnWidth = 3
Cells.RowHeight = 16.5
'Selection.RowHeight = 16.5
Range("A1").Select
'Druckbereich festlegen
Sheets(Titel).PageSetup.PrintArea = "$A$1:$AF$83"
'Drucker eigenschaften
Application.PrintCommunication = False
With ActiveSheet.PageSetup
'.LeftHeader = ""
.CenterHeader = "Planung " & Titel
'.RightHeader = ""
.LeftHeader = "&D"
'.CenterFooter = ""
'.RightFooter = ""
'.LeftMargin = Application.InchesToPoints(0.78740157480315)
'.RightMargin = Application.InchesToPoints(0.78740157480315)
'.TopMargin = Application.InchesToPoints(0.984251968503937)
'.BottomMargin = Application.InchesToPoints(0.984251968503937)
'.HeaderMargin = Application.InchesToPoints(0.511811023622047)
'.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = True
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA3
'.FirstPageNumber = xlAutomatic
'.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
'.OddAndEvenPagesHeaderFooter = False
'.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
'.EvenPage.LeftHeader.Text = ""
'.EvenPage.CenterHeader.Text = ""
'.EvenPage.RightHeader.Text = ""
'.EvenPage.LeftFooter.Text = ""
'.EvenPage.CenterFooter.Text = ""
'.EvenPage.RightFooter.Text = ""
'.FirstPage.LeftHeader.Text = ""
'.FirstPage.CenterHeader.Text = ""
'.FirstPage.RightHeader.Text = ""
'.FirstPage.LeftFooter.Text = ""
'.FirstPage.CenterFooter.Text = ""
'.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
'in pdf exportieren und an Ort speichern
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Temp\" & Format(Now, "YYYY") & "_Planung_" & Titel & "_" & Format(Now, _
"YYYYMMDD_hhmm") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'Ab hier kommt das E-Mail Modul
'Range("a1:z44").Select
strFileName = "C:\Temp\" & Format(Now, "YYYY") & "_Planung_" & Titel & "_" & Format(Now, _
"YYYYMMDD_hhmm") & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Set OutApp = CreateObject("Outlook.Application")
AWS = strFileName
'InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Range("A82") 'Empfänger
'.Cc = Range("A82") 'CC-Empfänger
'.Bcc = "bbb@bb.de" 'Blindempfänger
.Subject = "[Aktuelle persönliche Planung] " ' & " - " & Range("C6") & " - " & Range("V6") _
_
_
_
'Betreff, Name, Datum
.Attachments.Add AWS
.HTMLBody = "Hallo, " & "" & "Im Dateianhang findest Du Deine aktuelle persönliche Planung." _
_
_
& "" _
& "Viele Grüße." & "" & Range("C6") 'Hier wird die HTML Mail erstellt
'.Display 'Hier wird die Mail nochmals angezeigt
.Send 'Direkt senden
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Kill strFileName
'Hier Endet das E-Mail Modul
'Neuees Sheet (Tiel) löschen
Worksheets(Titel).Delete
'Bildschirmaktualisierug ausschalten
Application.ScreenUpdating = True
'Fehlermeldungen ausschalten
Application.DisplayAlerts = True
Beep 'Erfolgskontrolle, wenn Beep dann fertig durchgelaufen
End Sub
Bei mir läuft alles ohne Probleme durch und die Seiten werden korrekt eingerichtet (auf eine seite anpassen).
Wenn ich die Datei an einen anderen PC mit nehme (Selbes Betriebssystem, selbe OfficeVersion und sogar selber Standarddrucker) erhalte ich folgende Fehlermeldung und das Programm stoppt:
"Laufzeitfehler 1004: Die Methode "PrintCommunication" für das Objekt "_Application" ist fehlgeschlagen."
Der Debugger hält auch bei "Application.PrintCommunication = True" an. Wenn ich einfach auf weiter klicke, läuft es zumindest voll durch, jedoch werden die Seiten nicht mehr angepasst (eine Seite).
Kann mir jemand weiterhelfen?
Vielen Dank im Voraus,
Dennis.