Word: Copy Page Styles
Page Style manipulation
This is a set of two macros that I wrote to copy and paste a Microsoft page style - that is, copy the headers+footers+margins. LibreOffice and OpenOffice solve this by using the concept of Page Styles which is very elegant and intuitive. Microsoft Word on the other hand, does seemingly unpredictable things when copying and pasting pages. Well it turns out that the headers+footers+margins are stored in the Section Break at the end of the section. This macro exploits this to allow you to take an existing headers+footers+margins and apply it to any other section.
If you have an existing page style that you want to apply to another page, all you need to do is:
Click on the page you want to copy the headers+footers+margins from.
Run the "CopyPageStyle" macro.
Click on the page you want to paste the headers+footers+margins to.
Run the "PastePageStyle" macro.
It's as easy as that!
The code is long and complicated because it needs to handle the scenario where the section is the last section. Unfortunately Word does really crazy things on the last page (it stores section formatting inside the last Para mark!). See http://support.microsoft.com/kb/291184 for more details.
BUGS:
There is a strange edge case if you use columns or continuous line breaks: because each type of section stores its own header/footer settings, you may find that you cannot paste the header/footer unless you select just before the break. If this happens, you may need to insert a page break to force the header and footer to appear first, then paste the style, then delete the page break. See https://answers.microsoft.com/en-us/msoffice/forum/all/link-to-previous-is-not-working/8595cfe9-5e75-4dbb-af35-a5d73d421408 for more details. Can this be fixed in the macro? Probably. Will I fix it? Probably not. I think the unlink and link all macro probably needs to be fixed instead.
It probably won't work very well if you have "Different first page" selected. Really you probably should not use this option anyway! Just insert a normal section break instead.
Note: The macro unlinks the header+footer first, then copies the page style. You might need to relink the header+footer after doing the copy process. See http://wordprocessing.about.com/od/wordprocessingsoftware/ss/Word-2010-Advancd-Headers-And-Footers_4.htm for more details.
Sub CopyPageStyle()
Dim iPgNum As Integer
Dim sPgNum As String
Dim ascChar As Integer
' Set bookmark for return.
ActiveDocument.Bookmarks.Add Name:="WhereYouWere", Range:=Selection.Range
' Repaginate the document.
ActiveDocument.Repaginate
' If the Header/Footer is linked, Unlink this last Header/Footer to the previous
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
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.LinkToPrevious = True Then
HeaderWasLinked = True
Selection.HeaderFooter.LinkToPrevious = False
MsgBox ("Note: Header has been unlinked to previous section.")
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
If Selection.HeaderFooter.LinkToPrevious = True Then
FooterWasLinked = True
Selection.HeaderFooter.LinkToPrevious = False
MsgBox ("Note: Footer has been unlinked to previous section.")
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^b"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found Then
Selection.Copy
' Return to starting location.
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
' Delete the return marker.
ActiveDocument.Bookmarks("WhereYouWere").Delete
Else
' If at the end of the Document, add a Section Page Break and copy that.
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
ActiveDocument.Bookmarks.Add Name:="WhereYouWere2", Range:=Selection.Range
Selection.MoveRight
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.MoveLeft Unit:=wdCharacter, Count:=1
CopyPageStyle
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere2"
ActiveDocument.Bookmarks("WhereYouWere2").Delete
Exit Sub
End If
StatusBar = "Next Section Break copied"
End Sub
Sub PastePageStyle()
Dim iPgNum As Integer
Dim sPgNum As String
Dim ascChar As Integer
' Set bookmark for return.
ActiveDocument.Bookmarks.Add Name:="WhereYouWere", Range:=Selection.Range
' Repaginate the document.
ActiveDocument.Repaginate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^b"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found Then
' Go to next section and unlink it
Selection.Find.Execute
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.HeaderFooter.LinkToPrevious = False
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
Selection.Find.Execute
' Now overwrite the Section with the copied section
Selection.Paste
' Return to starting location.
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
' Delete the return marker.
ActiveDocument.Bookmarks("WhereYouWere").Delete
Else
' It's the last section, which requires some trickery!
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1
' Copy the page margins
With Selection.PageSetup
Param1 = .LineNumbering.Active
Param2 = .Orientation
Param3 = .TopMargin
Param4 = .BottomMargin
Param5 = .LeftMargin
Param6 = .RightMargin
Param7 = .Gutter
Param8 = .HeaderDistance
Param9 = .FooterDistance
Param10 = .PageWidth
Param11 = .PageHeight
Param12 = .FirstPageTray
Param13 = .OtherPagesTray
Param14 = .SectionStart
Param15 = .OddAndEvenPagesHeaderFooter
Param16 = .DifferentFirstPageHeaderFooter
Param17 = .VerticalAlignment
Param18 = .SuppressEndnotes
Param19 = .MirrorMargins
Param20 = .TwoPagesOnOne
Param21 = .BookFoldPrinting
Param22 = .BookFoldRevPrinting
Param23 = .BookFoldPrintingSheets
Param24 = .GutterPos
End With
' Move to next page
Selection.MoveRight Unit:=wdCharacter, Count:=1
' Overwrite the page margins
With Selection.PageSetup
.LineNumbering.Active = Param1
.Orientation = Param2
.TopMargin = Param3
.BottomMargin = Param4
.LeftMargin = Param5
.RightMargin = Param6
.Gutter = Param7
.HeaderDistance = Param8
.FooterDistance = Param9
.PageWidth = Param10
.PageHeight = Param11
.FirstPageTray = Param12
.OtherPagesTray = Param13
.SectionStart = Param14
.OddAndEvenPagesHeaderFooter = Param15
.DifferentFirstPageHeaderFooter = Param16
.VerticalAlignment = Param17
.SuppressEndnotes = Param18
.MirrorMargins = Param19
.TwoPagesOnOne = Param20
.BookFoldPrinting = Param21
.BookFoldRevPrinting = Param22
.BookFoldPrintingSheets = Param23
.GutterPos = Param24
End With
' Link this last header to the previous
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
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = True
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.HeaderFooter.LinkToPrevious = True
' Now Unlink this last header to the previous
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
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.HeaderFooter.LinkToPrevious = False
' Delete last section
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
With Selection.Find
.Text = "^b"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
' Return to starting location.
Selection.GoTo What:=wdGoToBookmark, Name:="WhereYouWere"
' Delete the return marker.
ActiveDocument.Bookmarks("WhereYouWere").Delete
End If
End Sub