Bereik afprinten.

[danny147]

Beste,

Heb een macro gemaakt die ik al een heel stuk heb ingekort.

De printer van ons werk is:

"\\PSMSC007\PRLADBU3 op Ne04:"

Deze heb ik erbij geplaatst, maar of dit juist is... ?
En kan ze ook nog eventueel korter, maar hou rekening met de marges ?

Sub Printen()

    Range("B7:AG25").Select
    ActiveSheet.PageSetup.PrintArea = "$B$7:$AG$25"
    
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = _
        "&""-,Vet""&24&UOverzicht aan- en afwezigheden en eventuele wachtdienst."
        .RightHeader = ""
        .LeftFooter = "&D"
        .CenterFooter = "ALD - CW - OLM "
        .RightFooter = "SIDDESD"
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.708661417322835)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    Application.ActivePrinter = "\\PSMSC007\PRLADBU3 op Ne04:"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
    ActivePrinter:="\\PSMSC007\PRLADBU3 op Ne04:", Collate:=True
    
    'ExecuteExcel4Macro "PRINT(1,,,1,,TRUE,,,,,,2,,,TRUE,,FALSE)"
    'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub

Groetjes Danny. :thumb:

 

[Superzeeuw]

Danny,

Wat is nu het probleem?

 

[danny147]

Beste Superzeeuw

Gewoon de vraag, kan de code korter ?

Groetjes Danny. :thumb:

 

[Warme bakkertje]

Dit is het enige dat ik zo direct kan bedenken

Sub Printen()
      With ActiveSheet.PageSetup
        .PrintArea = "$B$7:$AG$25"
        .LeftHeader = ""
        .CenterHeader = _
        "&""-,Vet""&24&UOverzicht aan- en afwezigheden en eventuele wachtdienst."
        .RightHeader = ""
        .LeftFooter = "&D"
        .CenterFooter = "ALD - CW - OLM "
        .RightFooter = "SIDDESD"
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.708661417322835)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    Application.ActivePrinter = "\\PSMSC007\PRLADBU3 op Ne04:"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
    ActivePrinter:="\\PSMSC007\PRLADBU3 op Ne04:", Collate:=True
    
    'ExecuteExcel4Macro "PRINT(1,,,1,,TRUE,,,,,,2,,,TRUE,,FALSE)"
    'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub

 

[danny147]

Beste Warme bakkertje

Bedankt voor de snelle reactie, zal het woensdag op het werk eens uittesten.
Daarna op opgelost plaatsen.

Groetjes Danny. :thumb:

 

[Superzeeuw]

Danny en Rudi,

Dan kan het nog korter want bepaalde waarden staan default ingesteld en die hoef je met code niet nog eens op default te zetten.
Application.activeprinter kan er ook uit want in de volgende regel wordt deze nogmaals gezet.
Zie mijn poging.

Sub Printen()
      With ActiveSheet.PageSetup
        .PrintArea = "$B$7:$AG$25"
        .CenterHeader = _
        "&""-,Vet""&24&UOverzicht aan- en afwezigheden en eventuele wachtdienst."
        .LeftFooter = "&D"
        .CenterFooter = "ALD - CW - OLM "
        .RightFooter = "SIDDESD"
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.708661417322835)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
    ActivePrinter:="\\PSMSC007\PRLADBU3 op Ne04:", Collate:=True
    
    'ExecuteExcel4Macro "PRINT(1,,,1,,TRUE,,,,,,2,,,TRUE,,FALSE)"
    'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub

 

[danny147]

Beste Superzeeuw

Bedankt, zal hem morgen proberen te testen op het werk.

Groetjes Danny. :thumb:

 

[danny147]

Beste Superzeeuw en Warme bakkertje

Bedankt voor jullie medewerking aan de ingekorte code.

Heb ze uitgeprobeerd deze morgend en ze werkt.

Groetjes Danny. :thumb: