Fehler Page.Setup

  • Excel

    Fehler Page.Setup

    Hallo,

    habe folgendes Problem. Per Klick werden Bestell Listen erstellt, inkl. Formatierung (Druckereinstellung etc.) und anschließend gespeichert. Das ganze läuft soweit, nach so ca. 12-14 Kunden erscheint allerdings folgende Fehlermeldung.

    "Die Methode Orientation für das Objekt Page.Setup ist fehlgeschlagen"

    Kann man den Drucker per Befehl zurücksetzen?

    Im Arbeitsblatt System R1 wird nach Start der aktuelle Drucker gespeichert. Irgendwie kann er nach den besagten 12-14x nicht mehr auf den Drucker zugreifen, der Code war vorher bissl kompakter, hab dann Speicherung des aktuellen Drucker's in diesem Arbeitsblatt getan, nur immer der gleiche nervende Fehler.

    Visual Basic-Quellcode

    1. Worksheets("Angebot").Cells(1, 1).Select
    2. druckenzeile = 11
    3. druckenspalte = "F"
    4. druckbereich = Worksheets("angebot").Range("B" & Rows.Count).End(xlUp).Row
    5. If Worksheets("system").Range("r1") <> "" Then
    6. druckerprogramm = Worksheets("system").Range("r1")
    7. Application.ActivePrinter = druckerprogramm
    8. Call Drucken55
    9. Else
    10. Call Drucken
    11. End If
    12. Call pruefennetzlaufwerk
    13. If netzfehler = 0 Then GoTo ohnefehler
    14. If MsgBox("Netzlaufwerk momentan nicht verfügbar, möchten Sie einen alternativen Speicherort auswählen? Bedenken Sie, dass die Datei im Netzlaufwerk nicht aktualisiert wird.", vbYesNo) = vbNo Then MsgBox ("Kann Datei nicht speichern, überprüfen Sie das Netzwerkkabel oder starten Sie den PC neu!"): GoTo zuende1
    15. MyPath = GetExcelfolder
    16. If Right$(MyPath, 1) = "\" Then MyPath = Left$(MyPath, Len(MyPath) - 1)
    17. Application.ScreenUpdating = False
    18. sWks = "Bestell-Liste"
    19. spath = MyPath & "\Woechentliche_Bestellliste_für_Kunde_" & kKundennummer & "_" & kKundenname & "_" & datum & ".xlsx"
    20. GoTo ohnefehler1
    21. ohnefehler:
    22. Application.ScreenUpdating = False
    23. sWks = "Bestell-Liste"
    24. verzeichnis99 = laufwerk & "\Frische_Angebot_System\"
    25. dateiname99 = kKundennummer
    26. Call dateiverschieben
    27. spath = laufwerk & "\Frische_Angebot_System\Woechentliche_Bestellliste_für_Kunde_" & kKundennummer & "_" & kKundenname & "_" & datum & ".xlsx"
    28. ohnefehler1:
    29. Worksheets("Angebot").Copy
    30. ActiveSheet.name = sWks
    31. ActiveWorkbook.SaveAs spath
    32. Application.ScreenUpdating = True
    33. SAM1.Image20.Visible = True
    34. MsgBox ("Datei wurde fertig erstellt und wie folgt gespeichert: " & spath)


    Visual Basic-Quellcode

    1. Sub Drucken55()
    2. With ActiveSheet.PageSetup
    3. .Zoom = False
    4. .FitToPagesWide = 1
    5. .FitToPagesTall = False
    6. .Orientation = xlLandscape
    7. .TopMargin = Application.CentimetersToPoints(0.5)
    8. .BottomMargin = Application.CentimetersToPoints(0.5)
    9. .LeftMargin = Application.CentimetersToPoints(0.5)
    10. .RightMargin = Application.CentimetersToPoints(0.5)
    11. .PrintArea = "$A$1:$" & druckenspalte & "$" & druckbereich
    12. .PrintTitleRows = "$1:$" & druckenzeile
    13. End With
    14. End Sub


    Visual Basic-Quellcode

    1. Sub Drucken
    2. Dim test As Boolean
    3. On Error GoTo error
    4. Dim drucker As String
    5. weiter:
    6. If druckerprogramm = "Falsch" Then GoTo error
    7. If Application.ActivePrinter = "" And druckerprogramm = "" Then druckerprogramm = "Falsch": GoTo weiter
    8. If Application.ActivePrinter = "" And druckerprogramm <> "" Then druckerprogramm = Worksheets("system").Range("r1"): drucker = druckerprogramm: Application.ActivePrinter = drucker: GoTo weiter
    9. drucker = Worksheets("system").Range("r1"): Application.ActivePrinter = drucker
    10. Application.ActivePrinter = drucker
    11. With ActiveSheet.PageSetup
    12. .Zoom = False
    13. .FitToPagesWide = 1
    14. .FitToPagesTall = False
    15. .Orientation = xlLandscape
    16. .TopMargin = Application.CentimetersToPoints(0.5)
    17. .BottomMargin = Application.CentimetersToPoints(0.5)
    18. .LeftMargin = Application.CentimetersToPoints(0.5)
    19. .RightMargin = Application.CentimetersToPoints(0.5)
    20. .PrintArea = "$A$1:$" & druckenspalte & "$" & druckbereich
    21. .PrintTitleRows = "$1:$" & druckenzeile
    22. End With
    23. GoTo zuende
    24. error:
    25. MsgBox ("Bitte wählen Sie im Folgenden einen aktiven Drucker aus, damit entsprechende Parameter gesetzt werden können!")
    26. test = Application.Dialogs(xlDialogPrinterSetup).Show
    27. If test = True Then druckerprogramm = Application.ActivePrinter: Worksheets("system").Range("r1") = druckerprogramm
    28. If test = False Then MsgBox ("Sie müssen zwingend einen Drucker auswählen, um Bestell Listen zu erstellen!"): druckerprogramm = "Falsch"
    29. GoTo weiter
    30. zuende:
    31. End Sub


    Danke

    Gruss