[Løst] Excel 2007 VBA Lagre nytt ark og legge inn sideoppsett

[Bigelk]

Hei.

 

Jeg lager en statistikk hver dag, så lagrer jeg den som et nytt ark ved hjelp av en makro.

Men jeg vil ha sideoppsettet Liggende og at den skrives ut på en side.

Bredde 1 side

lengde 1 side

 

Jeg har Registrert en makro på dette, men lurer på om det finnes en kortere kode enn det her

With ActiveSheet.PageSetup
       .PrintTitleRows = ""
       .PrintTitleColumns = ""
   End With
   ActiveSheet.PageSetup.PrintArea = ""
   With ActiveSheet.PageSetup
       .LeftHeader = ""
       .CenterHeader = ""
       .RightHeader = ""
       .LeftFooter = ""
       .CenterFooter = ""
       .RightFooter = ""
       .LeftMargin = Application.InchesToPoints(0.7)
       .RightMargin = Application.InchesToPoints(0.7)
       .TopMargin = Application.InchesToPoints(0.787401575)
       .BottomMargin = Application.InchesToPoints(0.787401575)
       .HeaderMargin = Application.InchesToPoints(0.3)
       .FooterMargin = Application.InchesToPoints(0.3)
       .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 = 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
   With ActiveSheet.PageSetup
       .PrintTitleRows = ""
       .PrintTitleColumns = ""
   End With
   ActiveSheet.PageSetup.PrintArea = ""
   With ActiveSheet.PageSetup
       .LeftHeader = ""
       .CenterHeader = ""
       .RightHeader = ""
       .LeftFooter = ""
       .CenterFooter = ""
       .RightFooter = ""
       .LeftMargin = Application.InchesToPoints(0.7)
       .RightMargin = Application.InchesToPoints(0.7)
       .TopMargin = Application.InchesToPoints(0.787401575)
       .BottomMargin = Application.InchesToPoints(0.787401575)
       .HeaderMargin = Application.InchesToPoints(0.3)
       .FooterMargin = Application.InchesToPoints(0.3)
       .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 = 0
       .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
   With ActiveSheet.PageSetup
       .PrintTitleRows = ""
       .PrintTitleColumns = ""
   End With
   ActiveSheet.PageSetup.PrintArea = ""
   With ActiveSheet.PageSetup
       .LeftHeader = ""
       .CenterHeader = ""
       .RightHeader = ""
       .LeftFooter = ""
       .CenterFooter = ""
       .RightFooter = ""
       .LeftMargin = Application.InchesToPoints(0.7)
       .RightMargin = Application.InchesToPoints(0.7)
       .TopMargin = Application.InchesToPoints(0.787401575)
       .BottomMargin = Application.InchesToPoints(0.787401575)
       .HeaderMargin = Application.InchesToPoints(0.3)
       .FooterMargin = Application.InchesToPoints(0.3)
       .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 = 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

 

Hilsen Torbjørn

[Bigelk]

Hei.

 

Kommet litt lengre på den her, men får fortsatt ikke til at Bredde blir 1 side og høyde blir 1 side.

 

Sheets(x).Activate
With ActiveSheet.PageSetup
   .Orientation = xlLandscape
   .PaperSize = xlPaperA4
   .FitToPagesWide = 1
   .FitToPagesTall = 1
End With

 

Noen forslag?

 

Hilsen

 

Torbjørn

[Bigelk]

Hei.

 

Da var den løst.

Etter og leitet litt på nettet og tatt opp en makro, og fjerna linje etter linje. så kom jeg fram til en veldig kort makro.

som går kjempe fort. Men den er ikke noen mal fordi ".zoom 69" blir akkuratt 1 ark for for hvordan arket mitt ser ut

 

Sheets("ark1").Activate
   With ActiveSheet.PageSetup
   .Zoom = 69
   .Orientation = xlLandscape

 

Hilsen

 

Torbjørn