Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1552to1556
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
20.04.2017 16:54:42
Dennis
Hallo Zusammen,
ich bekomme bei Ausführung leider einen Laufzeitfehler, den ich leider nichtbeseitigt bekomme.
Es erscheinen folgende Fehlermeldungen:
Userbild
Userbild
Das ist der Code:

Sub MA09Mail()
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("A24").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("A24:AF25").Copy Sheets(Titel).Range("A5")
'Februar Kopieren
Sheets("Februar").Range("B2:AF5").Copy Sheets(Titel).Range("B8")
Sheets("Februar").Range("A24:AF25").Copy Sheets(Titel).Range("A12")
'März Kopieren
Sheets("März").Range("B2:AF5").Copy Sheets(Titel).Range("B15")
Sheets("März").Range("A24:AF25").Copy Sheets(Titel).Range("A19")
'April Kopieren
Sheets("April").Range("B2:AF5").Copy Sheets(Titel).Range("B22")
Sheets("April").Range("A24:AF25").Copy Sheets(Titel).Range("A26")
'Mai Kopieren
Sheets("Mai").Range("B2:AF5").Copy Sheets(Titel).Range("B29")
Sheets("Mai").Range("A24:AF25").Copy Sheets(Titel).Range("A33")
'Juni Kopieren
Sheets("Juni").Range("B2:AF5").Copy Sheets(Titel).Range("B36")
Sheets("Juni").Range("A24:AF25").Copy Sheets(Titel).Range("A40")
'Juli Kopieren
Sheets("Juli").Range("B2:AF5").Copy Sheets(Titel).Range("B43")
Sheets("Juli").Range("A24:AF25").Copy Sheets(Titel).Range("A47")
'August Kopieren
Sheets("August").Range("B2:AF5").Copy Sheets(Titel).Range("B50")
Sheets("August").Range("A24:AF25").Copy Sheets(Titel).Range("A54")
'September Kopieren
Sheets("September").Range("B2:AF5").Copy Sheets(Titel).Range("B57")
Sheets("September").Range("A24:AF25").Copy Sheets(Titel).Range("A61")
'Oktober Kopieren
Sheets("Oktober").Range("B2:AF5").Copy Sheets(Titel).Range("B64")
Sheets("Oktober").Range("A24:AF25").Copy Sheets(Titel).Range("A68")
'November Kopieren
Sheets("November").Range("B2:AF5").Copy Sheets(Titel).Range("B71")
Sheets("November").Range("A24:AF25").Copy Sheets(Titel).Range("A75")
'Dezember Kopieren
Sheets("Dezember").Range("B2:AF5").Copy Sheets(Titel).Range("B78")
Sheets("Dezember").Range("A24:AF25").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, Jochen Plapp." ' & "" & 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

Kann mir jemand weiterhelfen?
Vielen Dank im Voraus,
Dennis.
PS: Falls jemand noch optimierungen für den Code hat gerne sagen, ich baue mit der Hand am Arm... ;-)

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Laufzeitfehler 1004
20.04.2017 17:01:47
Hajo_Zi
Hallo Dennis,
hat der Drucker vielleicht kein A3 Papier?

AW: Laufzeitfehler 1004
20.04.2017 17:12:10
Dennis
Hallo Hajo,
naja, eigentlich ist mein Ziel eine PDF im A3-Format zu erstellen. Deshalb stelle ich die Papiergröße auf A3.
Das Problem ist auch das es am selben PC mal geht, mal wieder nicht...
MFG Dennis.
AW: Laufzeitfehler 1004
20.04.2017 17:29:35
Dennis
Frage ist noch offen - sorry hab den Haken vergessen!
AW: Laufzeitfehler 1004
20.04.2017 18:08:54
ChrisL
Hi Dennis
Ich vermute der zufällig aktive Printer (muss ja nicht zwingend der PDF-Printer sein, weil der Druckbefehl kommt erst später) hat kein A3.
ungetestet...
Dim strDrucker As String
strDrucker = Application.ActivePrinter
Application.ActivePrinter = "Dein-PDF-Printer"
' Code dazwischen
Application.ActivePrinter = strDrucker

cu
Chris
Anzeige
AW: Laufzeitfehler 1004
21.04.2017 08:26:45
Dennis
Guten Morgen Chris,
vielen Dank für Deine Hilfe.
Bitte verzeih mir meine Unkenntnis - wo genau muss ich in dem Code deine Zeilen einbauen?
Der Drucker bei mir heißt dann "FreePDF" - soll ich das genau so eintragen?
Hast Du sonst noch "optimierungsmöglichkeiten" die Sinn machen?
Nochmals,
herzlichen Dank!
Dennis.
AW: Laufzeitfehler 1004
21.04.2017 08:48:13
ChrisL
Hi Dennis
Dim strDrucker As String
strDrucker = Application.ActivePrinter
Application.ActivePrinter = "FreePDF"
' existierender Code hier
Application.ActivePrinter = strDrucker

Optimierung naja...
Range("A1").Select --> kann vermutlich gelöscht werden
Ansonsten wäre es m.E. nur Kosmetik den Code zu kürzen und übersichtlicher darzustellen. Auf die Performance hätte dies kaum Auswirkungen. Generell sind Drucker- und PageSetup-Geschichten eher langsam.
Was mir noch auffällt. Die Tabellenblätter sprichst du über den Namen an...
Dim Titel As String
Titel = Sheets(1).Range("A24").Value
Sheets(Titel).Range(...)...
Ich würde mir angewöhnen, Tabellen oder Mappen direkt als Variablen zu definieren. Es erhöht die Übersichtlichkeit zumal eine Variable "Titel" nicht unbedingt auf einen Tabellennamen schliessen lässt:
Dim strTitel As String
Dim wksUebersicht As Worksheet
strTitel = Worksheets(1).Range("A24").Value
Set wksUebersicht = Worksheets(Titel)
wksUebersicht.Range(...)...
Generell solltest du Option Explicit aktivieren, was dich zwingt, alle Variablen sauber zu deklarieren. Es geht auch ohne, aber erhöht die Fehleranfälligkeit.
Sheets(1) kann übrigens theoretisch auch ein Diagrammblatt sein.
Worksheets(1) ist hingegen sicher ein Tabellenblatt.
cu
Chris
Anzeige
AW: Laufzeitfehler 1004
21.04.2017 09:00:46
Dennis
Hallo Chris,
vielen Dank für Deine schnelle Antwort.
Ich werde mir auch deine Tipps zu Herzen nehmen und den Code bei gelegenheit dank Deiner Ausführungen mal optimieren.
Jedoch der Aktuelle Code gibt jetzt ganz oben bei der Zeile: "Application.ActivePrinter = "FreePDF"" eine Fehlermeldung, nämlich "Laufzeitfehler 1004 - Die Methode "ActivePrinter" für das Objekt "_Application" ist fehlgeschlagen".
Hast Du hierzu einen Tipp?
LG Dennis.
AW: Laufzeitfehler 1004
21.04.2017 10:16:38
ChrisL
Hi Dennis
Zeichne einen manuellen Druckvorgang mit dem Makrorekorder auf und prüfe die Bezeichnung vom Drucker im aufgezeichneten Code.
cu
Chris
Anzeige
AW: Laufzeitfehler 1004
21.04.2017 11:09:54
Dennis
Hey Chris,
ich habe mit dem Recorder drei verschiedene Drucker ausgewählt und ausgedruckt... Den Recorder habe ich jeweils gestartet und dann den Drucker ausgewählt und gedruckt...
Wie Du siehst ist es immer das selbe Makro... Mist... :-( Das ich einen anderen Drucker auswähle wird garnicht zur Kenntnis genommen.
Sub Makro1()
' Makro1 Makro
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub
Sub Makro2()
' Makro2 Makro
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub
Sub Makro3()
' Makro3 Makro
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub

Anzeige
AW: Laufzeitfehler 1004
21.04.2017 11:20:11
ChrisL
Die Idee wäre gewesen die PDF-Drucker Auswahl aufzuzeichnen, damit du die korrekte Bezeichnung prüfen kannst.
Dann ändere mal kurzzeitig den Default-Drucker auf PDF und führe folgendes Makro aus:
MsgBox Application.ActivePrinter
Es geht darum die richtige Bezeichnung für den Drucker zu ermitteln.
cu
Chris
AW: Laufzeitfehler 1004
21.04.2017 11:29:18
Dennis
Es wird folgender Drucker angezeigt:
"FreePDF auf Ne02:"
Ich habe versucht mit dem Makroeditor die neue Druckerauswahl aufzuzeichnen... leider ohne erfolg!
AW: Laufzeitfehler 1004
21.04.2017 11:45:49
Dennis
.
AW: Laufzeitfehler 1004
21.04.2017 13:14:14
ChrisL
Hi Dennis
Gut, dann probiere mal...
Sub t()
Dim strDrucker As String
strDrucker = Application.ActivePrinter
Application.ActivePrinter = "FreePDF auf Ne02:"
With ActiveSheet.PageSetup
.CenterHeader = "Planung " & Titel
.LeftHeader = "&D"
.PrintHeadings = True
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA3
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
End With
Application.ActivePrinter = strDrucker
End Sub

Allerdings kann ich bei mir auch PageSetup A3 einstellen, wenn der aktive Drucker kein A3 kennt. Vielleicht ist meine Theorie doch nicht richtig.
cu
Chris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige