My table goes beyond the borders of the page, I want to change the orientation of the pages where the table is located, but the orientation of all pages of the document is changing. The table is selected normally, but then the orientation of the entire document changes.
Sub slect1()
'
' slect1 Macro
'
'
ActiveDocument.Tables(1).Select
Selection.PageSetup.Orientation = wdOrientLandscape
End Sub
As when you use the Word interface, a page orientation change requires the addition of section breaks at the beginning and end of the rotated portion. Word's macro recorder can be informative. After deleting some less useful page setup properties:
ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start).InsertBreak Type:=wdSectionBreakNextPage
Selection.Start = Selection.Start + 1
ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak Type:=wdSectionBreakNextPage
With Selection.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(1.27)
.BottomMargin = CentimetersToPoints(1.27)
.LeftMargin = CentimetersToPoints(1.27)
.RightMargin = CentimetersToPoints(1.27)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(0.63)
.FooterDistance = CentimetersToPoints(0.63)
.PageWidth = CentimetersToPoints(27.94)
.PageHeight = CentimetersToPoints(21.59)
.SectionStart = wdSectionNewPage
End With
Related
I'm trying to make a macro where users can select a table within a document and switch the orientation of the specific page it's on to landscape. I've tried both recording doing the action and writing the macro myself but it never seems to work properly. This is as close as I've gotten but it makes the page the table is on and everything before it landscape.
Sub TableLandscape()
'
' TableLandscape Macro
'
'
'Selection.Collapse Direction:=wdCollapseEnd
'Selection.InsertBreak Type:=wdSectionBreakContinuous
'ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start).Collapse Direction:=wdCollapseStart
'Selection.InsertBreak _
Type:=wdSectionBreakNextPage
Selection.Start = Selection.Start + 1
ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
Type:=wdSectionBreakNextPage
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.6)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionContinuous
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
'ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
'Type:=wdSectionBreakNextPage
End Sub
Here's how to do that:
Sub RotatePage()
Dim TableRange As Range, TableStart As Range, TableEnd As Range
Set TableRange = Selection.Tables(1).Range
Set TableStart = TableRange.Duplicate
With TableStart
.SetRange Start:=TableStart.Start - 1, End:=TableStart.End
.Collapse Direction:=wdCollapseStart
.InsertBreak Type:=wdSectionBreakNextPage
End With
Set TableEnd = TableRange.Duplicate
With TableEnd
.SetRange Start:=TableEnd.Start, End:=TableEnd.End + 1
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
End With
TableRange.PageSetup.Orientation = wdOrientLandscape
End Sub
I made the following script to automatic plot the active worksheet to a certain layout, in the right footer I would like to show the name of the active worksheet followed by the page number, 'edit: found the 'Activesheet.Name' formula, but still don't know how to add the page number (layout of page number: actual page numer/total amount of pages)
Example of a wanted right footer:
PartA - 1/12
Is it btw also possible to include a front page with just the name of the current worksheet, displayed in a big font in the center? Or is it needed to design the excel worksheet that way that the first page just contains one active cell with the title in the center?
Application.PrintCommunication = False
Application.Dialogs(xlDialogPrinterSetup).Show
With ActiveSheet.PageSetup
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A:$N"
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "PROJECT X"
.RightHeader = ""
.LeftFooter = Sheets("instellingen").Cells(20, 2).Value
.CenterFooter = Sheets("instellingen").Cells(22, 2).Value
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.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 = 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
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Thanks :)
When you are looking for a syntax, recording a macro while you do the manual steps can be very helpful.
I used Excel's built-in Page 1 of ? custom filter to get the syntax you are after. Manually, I went to Page Layout > Page Setup > Header / Footer > Footer > Page 1 of ?
.RightFooter = ActiveSheet.Name & " - " & "Page &P of &N"
You can really force a page number, since you don't know how many pages there are. So it's the same as setting it in regular Excel.
Try this Page &[Page] of &[Pages]
Regular format taken from https://support.office.com/en-us/article/Add-or-remove-page-numbers-57ebb99e-0cfc-408b-864a-c805b5040ae7
Side note, isn't using .PageSetup slow? I can't remember if they fixed it or not? There is a trick with using the print setup from the Excel4 Macros that was much faster.
I am working on a macro that would plot through currently opened document sections one by one, check whether they are portrait or landscape, and set their margins (incl. header and footer) to given dimensions (which are different depending on the page orientation).
How do I detect the page orientation of each section and make it the current "selection" or put the cursor on its beginning, so the next line could set its margins and skip to the next section?
This is what I got so far:
Sub Margins()
Dim nOriginalPagination As Integer
Dim objSection As Section
Dim nPaperSize As Integer
Dim ContinueOn As Boolean
ContinueOn = False
nNumSects = ActiveDocument.Sections.Count
ActiveWindow.View.Type = wdPageView
If ActiveWindow.View.SeekView <> wdSeekMainDocument Then
ActiveWindow.View.SeekView = wdSeekMainDocument
End If
Selection.HomeKey wdStory, wdMove
For Each objSection In objDocument.Sections
iSecNum = Selection.Information(wdActiveEndSectionNumber)
With objSection.PageSetup
nPaperSize = PAPERLETTER
End With
Next
For Each objSection In objDocument.Sections
iSecNum = Selection.Information(wdActiveEndSectionNumber)
With objSection.PageSetup
'Set the margins, depending on the page orientation
If .Orientation = wdOrientPortrait Then
.TopMargin = CentimetersToPoints(2.23)
.BottomMargin = CentimetersToPoints(2.21)
.LeftMargin = CentimetersToPoints(3.17)
.RightMargin = CentimetersToPoints(3.17)
.HeaderDistance = CentimetersToPoints(0.96)
.FooterDistance = CentimetersToPoints(0.94)
Else
.TopMargin = CentimetersToPoints(3.17)
.BottomMargin = CentimetersToPoints(3.17)
.LeftMargin = CentimetersToPoints(2.21)
.RightMargin = CentimetersToPoints(2.23)
.HeaderDistance = CentimetersToPoints(1.9)
.FooterDistance = CentimetersToPoints(1.9)
End If
End With
Application.ScreenUpdating = True
Options.Pagination = nOriginalPagination
Selection.GoTo what:=wdGoToSection, Which:=wdGoToNext
Next
End Sub
Error says I am missing as object.
Your code has several issues:
undeclared variables
unnecessary use of the Selection object
ScreenUpdating being turned on without having been turned off
The line that is causing the error is:
For Each objSection In objDocument.Sections
This is because the undeclared variable objDocument is not set to anything.
The code you need is below:
Sub Margins()
Dim objDocument as Document
Dim objSection As Section
Application.ScreenUpdating = False
Set objDocument = ActiveDocument
For Each objSection In objDocument.Sections
With objSection.PageSetup
'Set the margins, depending on the page orientation
If .Orientation = wdOrientPortrait Then
.TopMargin = CentimetersToPoints(2.23)
.BottomMargin = CentimetersToPoints(2.21)
.LeftMargin = CentimetersToPoints(3.17)
.RightMargin = CentimetersToPoints(3.17)
.HeaderDistance = CentimetersToPoints(0.96)
.FooterDistance = CentimetersToPoints(0.94)
Else
.TopMargin = CentimetersToPoints(3.17)
.BottomMargin = CentimetersToPoints(3.17)
.LeftMargin = CentimetersToPoints(2.21)
.RightMargin = CentimetersToPoints(2.23)
.HeaderDistance = CentimetersToPoints(1.9)
.FooterDistance = CentimetersToPoints(1.9)
End If
End With
Next
Application.ScreenUpdating = True
End Sub
I've been using the following code to print a sheet (with VBA) in a workbook. We are currently using Excel 2010. I've used this code for a long time and now I have a user who says the printed copy comes out extremely small and light.
The user says she has to enlarge the print to a #12 and bold all the info on the sheet so that the information is readable. Otherwise she claims it is impossible to read because it is so small.
Is there any properties I can add to this code or make changes to the existing properties to ensure the copy is more readable?
Would it be better to print to a PDF file?
Thanks for your help and suggestions.........
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.PrintArea = ""
.CenterHeader = "&A "
.RightFooter = "&""Arial,Regular""&8&P of &N"
.LeftMargin = Application.InchesToPoints(0.35)
.RightMargin = Application.InchesToPoints(0.35)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintGridlines = True
.CenterHorizontally = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
In my macro I want to prompt for the page Orientation -- P or p for portrait, L or l for landscape.
Here is what I developed. It works - but want to know if there is a better/more efficient way to develop If statements for "OR" --- do I have to use a "nested" If??
Dim i As Integer
Dim oTbl As Table
Dim rng As Range
Dim Orientation As String
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(0.4)
.RightMargin = InchesToPoints(0.4)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.6)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
' set Orientation
Orientation = InputBox(Prompt:="Enter P for Portriait, L for Landscape")
If Orientation = "L" Then
With Selection.PageSetup
.Orientation = wdOrientLandscape
End With
ElseIf Orientation = "l" Then
With Selection.PageSetup
.Orientation = wdOrientLandscape
End With
Else
With Selection.PageSetup
.Orientation = wdOrientPortrait
End With
End If
I'm not sure is there a better (more efficient) way to develop MS Word page orientation... I would not use InputBox, but if you want to use it i'd do something like this:
AskAgain:
Orientation = InputBox(Prompt:="Enter P for Portriait, L for Landscape")
Select Case UCase(Orientation)
Case "L"
Selection.PageSetup.Orientation = wdOrientLandscape
Case "P"
Selection.PageSetup.Orientation = wdOrientPortrait
Case Else
GoTo AskAgain
End Select
To be honest... leave the decision to the user and do not prevent user to set page orientation from VBA code, but call print preview window. This is best way - in my opinion.