Maintaining headers across multiple sections

Question

I am trying to insert an image programmatically.  My goal is to have a page in the middle of a document that does not have the header and footer and the margins are reduced to the edges of the sheet.  The image I am inserting would need to completely fill the page to the extent the aspect ratios match.  On the page after the image page I want the header and footers to continue in the same format as the section before the image page.  Below is what I have coded so far but it is not working as expected.  Any direction would be greatly appreciated.

Sub AddImageObject()

Dim f As String

Dim d As Object

Dim p As Boolean

Dim i As Long

Dim j As Long

Dim k As Long

Dim l As Double

Dim r As Double

Dim t As Double

Dim b As Double

k = Selection.Information(wdActiveEndSectionNumber)

Set d = Application.FileDialog(msoFileDialogFilePicker)

With d

    .AllowMultiSelect = False

    .Title = "Please pick the file to insert."

    .Filters.Clear

    .Filters.Add "Image", "*.png"

    .Filters.Add "Image", "*.jpg"

    p = False

    p = .Show

    If p Then f = .SelectedItems.Item(1)

End With

'section break to stop using the header/footer formating

Selection.InsertBreak Type:=2

Selection.InsertBreak Type:=2

i = k + 2

With ActiveDocument.Sections(i)

    For j = 1 To 3

        .Headers(j).LinkToPrevious = True

        .Footers(j).LinkToPrevious = True

    Next j

    For j = 1 To 3

        .Headers(j).LinkToPrevious = False

        .Footers(j).LinkToPrevious = False

    Next j

End With

i = k + 1

'format the page to maximum window for the pdf of the same sheet size to be full size

With ActiveDocument.Sections(i)

    For j = 1 To 3

        .Headers(j).LinkToPrevious = False

        .Footers(j).LinkToPrevious = False

    Next j

    .PageSetup.LeftMargin = InchesToPoints(0)

    .PageSetup.TopMargin = InchesToPoints(0)

    .PageSetup.BottomMargin = InchesToPoints(0)

    .PageSetup.RightMargin = InchesToPoints(0)

End With

Selection.InlineShapes.AddPicture FileName:=f, LinkToFile:=False, SaveWithDocument:=True

End Sub

Answer 1

The space above the picture is taken up by the empty paragraph in the header of the document.  So after the command to delete the header, insert

 Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Font.Hidden = True

and make sure that the display of hidden text is turned off.

This is the result that I then get when running the code

Answer 2

This is the current code I'm running.  I'm also having trouble removing a space at the top of the image.  The image should be exactly the same size as the sheet so everything is shifted down.  I still want the header to continue on the next page if the image isn't on that page.

Thanks again for your help!

Sub AddImageObject()

Dim f As String

Dim d As Object

Dim p As Boolean

Dim i As Long

Dim j As Long

Dim k As Long

k = Selection.Information(wdActiveEndSectionNumber)

Set d = Application.FileDialog(msoFileDialogFilePicker)

With d

    .AllowMultiSelect = False

    .Title = "Please pick the file to insert."

    .Filters.Clear

    .Filters.Add "Image", "*.png"

    .Filters.Add "Image", "*.jpg"

    p = False

    p = .Show

    If p Then f = .SelectedItems.Item(1)

End With

'section break to stop using the header/footer formating

Selection.InsertBreak 2

ActiveDocument.Sections(k + 1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False

Selection.InsertBreak 3

Selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False

Selection.Move wdSection, -1

Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete

'format the page to maximum window for the pdf of the same sheet size to be full size

With Selection.ParagraphFormat

        .LeftIndent = InchesToPoints(0)

        .SpaceBeforeAuto = False

        .SpaceAfterAuto = False

End With

With ActiveDocument.Sections(k + 1)

    .PageSetup.BottomMargin = InchesToPoints(0)

    .PageSetup.RightMargin = InchesToPoints(0)

    .PageSetup.LeftMargin = InchesToPoints(0)

    .PageSetup.Gutter = InchesToPoints(0)

    .PageSetup.HeaderDistance = InchesToPoints(0)

    .PageSetup.FooterDistance = InchesToPoints(0)

    .PageSetup.TopMargin = InchesToPoints(0)

End With

Selection.InlineShapes.AddPicture FileName:=f, LinkToFile:=False, SaveWithDocument:=True

End Sub

Answer 3

The only reason that you would get an empty page after your image is if the Image is too large for it and the Section Break to fit on the one page.

Can you show the code that you are now using?

Answer 4

This was very close to what I was looking for.  One additional thing. 

I changed the second insertbreak to a continuous break to eliminate the blank page (no header) that follows my image page per the code above.  I added an additional Selection.InsertBreak at the end of the code to show a page with the header from before.  The page after does show up but it does not show the header.  If I manually select a break from the ribbon the header shows up.  Why is this different?  I do want the page after the image page to show the header after running the code.

Answer 5

Use the following coding to deal with the insertion of the section breaks while preserving the heading in the section after those breaks.

i = Selection.Information(wdActiveEndSectionNumber)

Selection.InsertBreak 2

ActiveDocument.Sections(i + 1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False

Selection.InsertBreak 2

Selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False

Selection.Move wdSection, -1

Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete