Moin Ralf

danke für deine Unterstützug und den Ansatz. Habe mich gleich mal versucht und Fehlermeldungen bekommen

Du siehst es lernt noch ;-)

Muss ich das "sh.PageSetup." vor jede Zeile setzen oder geht das auch globaler und einfacher?


 

Option Explicit

Sub Header()
'*******************************************************Header update bei Print ***************************************************************************************************
Dim sh As Object

Select Case ActiveSheet.Name
Case "Change History and Approvals", "Key"
Case Else

On Error GoTo Ende
   Application.ScreenUpdating = False
    Application.PrintCommunication = True
    'With ActiveSheet.PageSetup
    'With ActiveWindow.PageSetup.SelectedSheets
    For Each sh In ActiveWindow.SelectedSheets
    sh.PageSetup.LeftHeader = Worksheets("Standards").Range("I6") & vbLf & "Rev.:" & " " & Worksheets("Standards").Range("I4") & vbLf & "Date (Rev.):" & " " & Worksheets("Standards").Range("I5")
        sh.PageSetup.CenterHeader = ""
       sh.PageSetup.RightHeader = "&G"
        sh.PageSetup.LeftFooter = ""
        sh.PageSetup.CenterFooter = "&""Arial,Fett""&9&K0070C0PFC" & Chr(10) & "Page &P of &N"
        sh.PageSetup.RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 98  '100
        .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
    Next
    Application.PrintCommunication = False
    Application.ScreenUpdating = True
    
    End Select
 
Ende:
End Sub