Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1532to1536
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Laufzeitfehler 1004

Laufzeitfehler 1004
11.01.2017 18:10:19
Dennis
Hallo Zusammen,
ich habe vor - und das funktioniert bei mir auch echt super, dass aus einer Excel-Datei eine neue Datei erstellt wird, diese dann als PDF in einer Mail in Outlook versandt wird.
Bei mir funktioniert die Datei wie gesagt super - bei meinem Kollegen erscheint leider ein Laufzeitfehler 1004 und das Debugging startet. Wenn ich dem Makro dann sage weiter zu laufen, läuft es jedoch problemlos durch, außer dass die Seiteneinstellungen verloren gehen.
Könnt Ihr mir helfen?
Der Debugger bleibt bei "Application.PrintCommunication = True" nach den seiteneigenschaften - hier bleibt das Scirpt hängen.
Sub MA01Mail()
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").Select
Range("A2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Januar").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Februar Kopieren
Application.CutCopyMode = False
Sheets("Februar").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B8").Select
ActiveSheet.Paste
Sheets("Februar").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A12").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'März Kopieren
Application.CutCopyMode = False
Sheets("März").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B15").Select
ActiveSheet.Paste
Sheets("März").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A19").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'April Kopieren
Application.CutCopyMode = False
Sheets("April").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B22").Select
ActiveSheet.Paste
Sheets("April").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A26").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Mai Kopieren
Application.CutCopyMode = False
Sheets("Mai").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B29").Select
ActiveSheet.Paste
Sheets("Mai").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A33").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Juni Kopieren
Application.CutCopyMode = False
Sheets("Juni").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B36").Select
ActiveSheet.Paste
Sheets("Juni").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A40").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Juli Kopieren
Application.CutCopyMode = False
Sheets("Juli").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B43").Select
ActiveSheet.Paste
Sheets("Juli").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A47").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'August Kopieren
Application.CutCopyMode = False
Sheets("August").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B50").Select
ActiveSheet.Paste
Sheets("August").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A54").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'September Kopieren
Application.CutCopyMode = False
Sheets("September").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B57").Select
ActiveSheet.Paste
Sheets("September").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A61").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Oktober Kopieren
Application.CutCopyMode = False
Sheets("Oktober").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B64").Select
ActiveSheet.Paste
Sheets("Oktober").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A68").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'November Kopieren
Application.CutCopyMode = False
Sheets("November").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B71").Select
ActiveSheet.Paste
Sheets("November").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A75").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Dezember Kopieren
Application.CutCopyMode = False
Sheets("Dezember").Select
Range("B2:AF5").Select
Selection.Copy
Sheets(Titel).Select
Range("B78").Select
ActiveSheet.Paste
Sheets("Dezember").Select
Range("A8:AF9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Titel).Select
Range("A82").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Zellen Anpassen
Columns("A").Select
Selection.EntireColumn.AutoFit
Columns("B:AG").Select
Selection.ColumnWidth = 3
Cells.Select
Selection.RowHeight = 16.5
Application.CutCopyMode = False
Range("A1").Select
'Druckbereich festlegen
Sheets(Titel).Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$83"
'Drucker eigenschaften
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Planung " & Titel
.RightHeader = ""
.LeftHeader = "&B&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 = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = True
.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
Dim Nachricht As Object, OutApp As Object
Dim AWS As String
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


3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Laufzeitfehler 1004
11.01.2017 21:19:20
Gerd
Hi, lt. Recherche gibt es diese Eigenschaft ab Office 2013 u.soll
ggf. vor dem ersten Pagesetup gesetzt werden, soll der Codebeschleunigung dienen
u. ist m.E. verzichtbar.
Steht im Modul oben "Option Explicit"?
Wie sind die Einstellungen im VBA-Editor zur Fehlerbehandlung
unter Extras-Optionen-Allgemein je PC?
Der Code kann natürlich noch erheblich eingedampt werden, weitestgehend ohne Selectiererei u. mit
zu Hilfenahme der Monthname-Funktion in einer Schleife.
cu
AW: Laufzeitfehler 1004
16.01.2017 08:19:09
Dennis
Hallo und guten Morgen Gerd,
vielen Dank für Dein Feedback.
Leider kann ich Dir nicht ganz folgen.
Ich verwende Office 2010.
Kannst Du mir ein wenig weiterhelfen - wie kann ich den Code eindampfen? Bitte entschuldige, ich bin in VBA nicht ganz so bewandert - aber naja, es funktioniert. ;-)
Wünsche euch eine gute Woche.
Liebe Grüße,
Dennis.
Anzeige
AW: Eindampfen
17.01.2017 17:47:26
Werner
Hallo Dennis,
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").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 = "&B&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 = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = True
.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
Gruß Werner
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige