Selection.PrintOut op 1 A4tje

[Dokman]

Hallo,

ik heb en button aangemaakt. Als ik nu ergens in mijn sheet willekeurig en paar cellen selecteer en dan op de button druk wordt het uit geprint.
Alleen nu wil ik graag dat hij het zo maakt dat het altijd op een a4tje vast in de breedte. Heb al verschillende dingen getest maar kom er niet uit.

Voorbeeld:
Ik wil nu G1 tot AB28 printen. Maar dan komt de kolom AB niet op hetzelfde blaadje. Maar hij mag het verkleinen dat het wel past.
Want de breedte is altijd hetzelfde. De lengte kan anders zijn elke keer. Dat kan ook AB10 of AB50 zijn.

ik gebruik nu de volgende code:

Sub PrintTheSelectedArea()
    'Print out a copy of your selected area
    Selection.PrintOut Copies:=1, collate:=True
End Sub

 

[AD1957]

Zo?

Sub Printen()

    Application.PrintCommunication = True
    ActiveSheet.PageSetup.FitToPagesWide = 1
    Application.PrintCommunication = False
    Selection.PrintOut Copies:=1, collate:=True

End Sub

 

[Dokman]

Niet echt. Want nu komt kolom AB nog steeds op en apart A4'tje Terwel die op dezelfde zou moeten als de andere kolommen.

 

[mvdvlist]

Macro opgenomen.
Ze3lf even aanpassen wat er uit kan...

Sub Macro2()
'
' Macro2 Macro
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .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 = xlPortrait
        .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 = 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
    Application.PrintCommunication = True
    Selection.PrintOut Copies:=1, Collate:=True
End Sub

 

[djutoch]

Sub afdrukken()
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .PaperSize = xlPaperA4
    .FitToPagesWide = 1
End With
Selection.PrintOut Copies:=1, Collate:=True
End Sub

 

[AD1957]

zo dan.

Sub Printen()   
With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
End With
Selection.PrintOut Copies:=1, collate:=True
 
End Sub

 

[Dokman]

Ik ben vandaag weer voor het eerst op kantoor. Dus en beetje late reacties.
Heb wel even alles uitgetest aan tips die jullie hebben gegeven.

Heb toch de code van @djutoch gebruikt.

Mag ik jullie allemaal bedanken.

 

[djutoch]

Dank voor de terugkoppeling.