Hallo zusammen,

ein (für Euch) wahrscheinlich recht triviales Ding:
Ich habe ein kleines tool gebastelt und möchte dies den Kollegen bereitstellen - die Konditionen des Ausdruckes möchte ich festlegen via Makro! Farbe, A3 quer, Druckqualität auf 1200 dpi und Einhaltung des vorhandenen Druckbereichs und anschließendem Printpreview.

Dies aus dem Grund, da diese Einstellungen nicht Standart auf jedem PC sind und der Ausdruck nur unter diesen Konditionen vernünftig auf Papier aussieht.

Beim Erstellen des Makros kamen keine Fehlermeldung, jedoch habe ich das Problem, dass bei Betätigung der Schaltfläche erst beim zweiten Anklicken das gewünschte Format angezeigt wird. Darüber hinaus wechselt er nicht zum farbigen Druck, wenn ich im Vorfeld auf schwarzweiss stehe. Wäre spitzenmässig wenn sich das einer mal anschauen würde, um mir unter die Arme zu greifen:

Sub Kennwerte()
'
' Kennwerte Makro
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$9:$U$81"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 1200
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .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 = True
        .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
    Range("$B$9:$U$81").PrintPreview
    Application.PrintCommunication = True
End Sub

Liebe Grüße
alex