Script to add page has footer problems
Hi,
Working with VBA on Word files that already has footer styles to accommodate pages of various sizes. My goal is to provide a VBA script that does the following in an 8.5X11 portrait-oriented document with footers:
1) Adds a section break followed by an 11X17 landscape page.
2) Applies a pre-existing style (Footer17) to that page.
I am a VBA novice, and every attempt I have made so far results in sizing issues for the other footers, or runs correctly in Debug mode but fails in real time. Any help would be appreciated, and I will be happy to provide any information that will help resolving this issue. Thanks!
Here's my code so far:
Sub Add11X17Landscape()
'
' Add11X17Landscape Macro
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.TypeText Text:="Inserted New Page"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.TypeParagraph
With Selection.Find
.Text = "Inserted New Page"
.Wrap = wdFindContinue
End With
If Selection.Find.Execute = True Then
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.4)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(17)
.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
If Selection.PageSetup.Orientation = wdOrientPortrait Then
Selection.PageSetup.Orientation = wdOrientLandscape
Else
Selection.PageSetup.Orientation = wdOrientPortrait
End If
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
' The script fails in this section. I also need to ensure that the footer in the page prior to the 11X17 page is marked "LinkToPrevious"
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
' New 11X 17 page
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekNextPageFooter
' Page following the 11X17
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.PreviousHeaderFooter
' back to the new11X17 page
Selection.WholeStory
Selection.Style = ActiveDocument.Styles("Footer17")
End If
End Sub
|