Instellen van Printbereik

Status
Niet open voor verdere reacties.
M

MEradus

Gebruiker
Lid geworden
25 nov 2012
Berichten
287
Hallo,

Ik ben wederom bezig met het maken van een rooster.
Nu zou ik graag willen dat de printer instellingen automatisch goed gezet worden.

Omdat dit dynamisch moet zijn zouden de volgde instellingen geactiveerd moeten worden.

"Selectie afdrukken"
"Alle marges op 0"
"Bladpassend maken voor 1 pagina"

Ik heb al gegoogled, maar kan het niet vinden.
Ook met macro opnemen kom ik er niet.

Ik hoop van harte dat iemand mij kan helpen.
 
Wat geeft de macrorecoder bij jou dan als resultaat ?

En waarom 'werkt dat dan niet' in jouw geval ?
 
Ik weet niet waarom het in mijn geval niet werk, als ik de instellingen aanpas terwijl ik aan het opnemen pakt hij een statisch bereik?
Nadat ik hem opgenomen heb, heb ik hem uitgeprobeerd, maar "Alleen selectie afdrukken" wordt niet ingesteld.
 
Onderstaand is een willekeurige selectie in een ander voor het opnemen.

Code: 
Range("D49:K69").Select
    Range("K69").Activate
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$70"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = "&14Pypskoft vervoer volksdansfeest"
        .CenterHeader = "&14Chauffeur : &10" & Chr(10) & "&14Bus : "
        .RightHeader = "&14Datum: 8/4/2016 "
        .LeftFooter = _
        "&""Arial,Vet""&12Tijd + Km noteren op deze lijst en inleveren:"
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .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 = 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
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$70"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = "&14Pypskoft vervoer volksdansfeest"
        .CenterHeader = "&14Chauffeur : &10" & Chr(10) & "&14Bus : "
        .RightHeader = "&14Datum: 8/4/2016 "
        .LeftFooter = _
        "&""Arial,Vet""&12Tijd + Km noteren op deze lijst en inleveren:"
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .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
End Sub
 
begin van bovenaf de regels die je niet nodig hebt te verwijderen.
Dan is de macro al een stuk overzichtelijker.
Laat hem dan per regel lopen F8 en kijk wat er in het werkblad gebeurt.
 
Laatst bewerkt:
Hierbij ook een stukje code voor printen:
Fit to page zorgt ervoor dat alles op 1 pagina past.
printArea zou je dan dinamisch moeten maken

Code: 
If A = vbYes Then

With ActiveSheet.PageSetup
    .LeftMargin = Application.CentimetersToPoints(1.5)
    .RightMargin = Application.CentimetersToPoints(1)
    .TopMargin = Application.CentimetersToPoints(1)
    .BottomMargin = Application.CentimetersToPoints(0.5)
    .HeaderMargin = Application.CentimetersToPoints(0.2)
    .FooterMargin = Application.CentimetersToPoints(0.2)
    .PaperSize = xlPaperA4
    .Orientation = xlPortrait 'xlLandscape
    
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
    .PrintArea = "$A$1:$G$45"
    
    End With
     Application.Dialogs(xlDialogPrinterSetup).Show
     ActiveSheet.PrintOut
End If
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan