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:

    1. Click on the page you want to copy the headers+footers+margins from.

    2. Run the "CopyPageStyle" macro.

    3. Click on the page you want to paste the headers+footers+margins to.

    4. 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:

  1. 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.

  2. 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