none
Word Macro to move top two lines of each page into the document header and the bottom line into the document footer RRS feed

  • Question

  • I was wondering if there is a way to create a macro which goes through each page of a word document and moves the top two lines of the page into the header of the page and moves the bottom line into the footer of the page.

    Any assistance is greatly appreciated.

    Thursday, February 16, 2012 3:51 PM

Answers

  • Hi Mike,

    Try:
    Sub ReformatPages()
    Application.ScreenUpdating = False
    Dim RngPg As Range, RngTmp As Range, PgCount As Long, i As Long
    With ActiveDocument
      PgCount = .ComputeStatistics(wdStatisticPages)
      For i = 2 To PgCount
        Set RngPg = .GoTo(What:=wdGoToPage, Name:=i)
        RngPg.InsertBreak Type:=wdSectionBreakNextPage
        Set RngPg = RngPg.GoTo(What:=wdGoToBookmark, Name:="\page")
        .Sections(i).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
        .Sections(i).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
      Next
      For i = 1 To PgCount
        Set RngTmp = .Sections(i).Range
        With RngTmp
          .Collapse wdCollapseStart
          .Duplicate.Select
        End With
        With Selection
          .Collapse wdCollapseStart
          .MoveEnd Unit:=wdLine, Count:=2
          .Cut
        End With
        .Sections(i).Headers(wdHeaderFooterPrimary).Range.Paste
        .Sections(i).Headers(wdHeaderFooterPrimary).Range.Characters.Last.Delete
        Set RngTmp = .Sections(i).Range
        With RngTmp
          .End = .End - 1
          .Collapse wdCollapseEnd
          .Duplicate.Select
        End With
        With Selection
          .MoveStart Unit:=wdLine, Count:=-2
          .Cut
        End With
        .Sections(i).Footers(wdHeaderFooterPrimary).Range.Paste
        .Sections(i).Footers(wdHeaderFooterPrimary).Range.Characters.Last.Delete
      Next
    End With
    Application.ScreenUpdating = True
    End Sub

    Note: If the last two lines on each page are one or more paragraphs in their own right, the macro could be made more efficient.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Sunday, February 19, 2012 7:37 AM
    • Marked as answer by mpducincy Sunday, February 19, 2012 4:09 PM
    Sunday, February 19, 2012 7:34 AM

All replies

  • Hi mpducincy,

    Well, yes, but it really isn't a practical proposition. In effect, you would have to insert a Next Page Section Break at the bottom of every page, unlink the next page's header & footer from the current page, then cut & paste the relevant content into the current page's header & footer. Once you've done that, the document is next-to-impossible to edit.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, February 17, 2012 8:45 AM
  • Thanks for the response Paul.  Glad to hear that in theory my goal might be attainable.  I'm wondering if the soulution that you suggest above can be done via a macro to apply to all pages in a document.  As it stands the document has no headers or footers.  The prize winning macro would not only create the headers and footers but then copy the desired content into the headers and footers for each page in the doc. 
    Friday, February 17, 2012 12:17 PM
  • Hi mpducincy

    Given what Paul says, it would probably make more sense to simply position a frame or text box at the top of each page (not actually in the header). That would avoid having to insert tons of section breaks, which could "break" the document.

    Another possibility would be to format the text you want to see in the header with a character style and place a StyleRef field in the document header for that style. That will update dynamically. See for example:
    http://wordfaqs.mvps.org/styleref.htm
    http://cybertext.wordpress.com/2009/01/30/word-use-styleref-field-to-populate-headerfooter/
    http://support.microsoft.com/kb/198371

    http://office.microsoft.com/en-us/word-help/field-codes-styleref-field-HP005186193.aspx

    Cindy Meister, VSTO/Word MVP

    Saturday, February 18, 2012 6:10 AM
    Moderator
  • Hi mpducincy,

    I could, but I can't imagine any situation in which this might actually serve a useful purpose. Perhaps you could explain why you think doing this is appropriate. There may be a better way of achieving the same appearance, as Cindy suggests


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Saturday, February 18, 2012 7:49 AM
  •  Hi Paul,

    I'm a SAS programmer.  The tables and listings that I generate using SAS are output to word documents.  The top two lines of each page of the output document contain general information about the content of the document as does the bottome line of each page.  There's no way through SAS to direct the output of the top two lines to the header of a word document and the botom line to the footer.  I could do this with an rtf file but not with a doc.  My hope was that I could easily take care of this formatting within word via a macro.  From what you've said it doesnt sound like an easy proposition.  Once again I greatly appreciate the time you've invested in this.

    Mike.

    Saturday, February 18, 2012 7:30 PM
  • Hi Mike,

    Try:
    Sub ReformatPages()
    Application.ScreenUpdating = False
    Dim RngPg As Range, RngTmp As Range, PgCount As Long, i As Long
    With ActiveDocument
      PgCount = .ComputeStatistics(wdStatisticPages)
      For i = 2 To PgCount
        Set RngPg = .GoTo(What:=wdGoToPage, Name:=i)
        RngPg.InsertBreak Type:=wdSectionBreakNextPage
        Set RngPg = RngPg.GoTo(What:=wdGoToBookmark, Name:="\page")
        .Sections(i).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
        .Sections(i).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
      Next
      For i = 1 To PgCount
        Set RngTmp = .Sections(i).Range
        With RngTmp
          .Collapse wdCollapseStart
          .Duplicate.Select
        End With
        With Selection
          .Collapse wdCollapseStart
          .MoveEnd Unit:=wdLine, Count:=2
          .Cut
        End With
        .Sections(i).Headers(wdHeaderFooterPrimary).Range.Paste
        .Sections(i).Headers(wdHeaderFooterPrimary).Range.Characters.Last.Delete
        Set RngTmp = .Sections(i).Range
        With RngTmp
          .End = .End - 1
          .Collapse wdCollapseEnd
          .Duplicate.Select
        End With
        With Selection
          .MoveStart Unit:=wdLine, Count:=-2
          .Cut
        End With
        .Sections(i).Footers(wdHeaderFooterPrimary).Range.Paste
        .Sections(i).Footers(wdHeaderFooterPrimary).Range.Characters.Last.Delete
      Next
    End With
    Application.ScreenUpdating = True
    End Sub

    Note: If the last two lines on each page are one or more paragraphs in their own right, the macro could be made more efficient.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Sunday, February 19, 2012 7:37 AM
    • Marked as answer by mpducincy Sunday, February 19, 2012 4:09 PM
    Sunday, February 19, 2012 7:34 AM
  • Works great! Thanks for the help Paul.

    Sunday, February 19, 2012 4:09 PM