Trouble with LinkToPrevious

[SamMurr]

Hi All,
I hope someone has a solution to this oddity. I am attempting with a macro to split a document that has tables and a header with specific information and insert a page that does not have tables and the specific information in the header is removed. I have the following code and if I step through it one line at a time from Microsoft Visual Basic for Applications it works fine. But if I just execute the macro the last section does not remove the LinkToPrevious even if I tell it more than once. I have tried going to the header telling LinkToPrevious to be false, then going back to the main document, and the going back to the header and telling LinkToPrevious to be false again and still it does not work. I am frustrated and under a time deadline. Any help would be greatly appreciated. I would like to know if this is just me or does it to it to others. Here is the code I have been playing with.

Sub Macro3()
'
' Macro3 Macro
'
'
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.InsertBreak Type:=wdSectionBreakNextPage
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
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.GoTo What:=wdGoToSection, Which:=wdGoToPrevious, Count:=1, Name _
:=""


ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.GoTo What:=wdGoToSection, Which:=wdGoToPrevious, Count:=1, Name _
:=""
Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""


ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""
Selection.GoTo What:=wdGoToSection, Which:=wdGoToPrevious, Count:=1, Name _
:=""
Selection.GoTo What:=wdGoToSection, Which:=wdGoToPrevious, Count:=1, Name _
:=""
Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""


Selection.TypeText Text:="Now is the time"
End Sub:yes

[gmayor]

If I understand correctly, you want to insert a page at the cursor that doesn't have the header on the previous and following page and you want the text "Now is the time" in that new currently empty page? In that case use ranges as it avoids opening and closing headers.


Sub Macro1()
Dim oRng As Range
Dim lngSect As Long
'Set a range to the cusror position
Set oRng = Selection.Range
'If the range is not a single point, collapse the range to its start
orng.collapse 1
'Insert two next page section breaks
oRng.InsertBreak wdSectionBreakNextPage
oRng.InsertBreak wdSectionBreakNextPage
'Get and record the section number of orng (which is now at the start of the page after the inserted page
lngSect = oRng.Information(wdActiveEndSectionNumber)
'Unlink the current section and the previous section headers
ActiveDocument.Sections(lngSect - 1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
ActiveDocument.Sections(lngSect).Headers(wdHeaderFooterPrimary).LinkToPrevi ous = False
'Ensure that the sectiosn either side of the inserted page have the same headers
ActiveDocument.Sections(lngSect).Headers(wdHeaderFooterPrimary).Range = ActiveDocument.Sections(lngSect - 2).Headers(wdHeaderFooterPrimary).Range
'Remove the header from the new page
ActiveDocument.Sections(lngSect - 1).Headers(wdHeaderFooterPrimary).Range.Text = ""
'Move the range to the new section
Set oRng = ActiveDocument.Sections(lngSect - 1).Range
'Collapse the range to the start of that section
oRng.Collapse 1
'Add the text
oRng.Text = "Now is the time"
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

[SamMurr]

If I understand correctly, you want to insert a page at the cursor that doesn't have the header on the previous and following page and you want the text "Now is the time" in that new currently empty page? In that case use ranges as it avoids opening and closing headers.


Sub Macro1()
Dim oRng As Range
Dim lngSect As Long
'Set a range to the cusror position
Set oRng = Selection.Range
'If the range is not a single point, collapse the range to its start
orng.collapse 1
'Insert two next page section breaks
oRng.InsertBreak wdSectionBreakNextPage
oRng.InsertBreak wdSectionBreakNextPage
'Get and record the section number of orng (which is now at the start of the page after the inserted page
lngSect = oRng.Information(wdActiveEndSectionNumber)
'Unlink the current section and the previous section headers
ActiveDocument.Sections(lngSect - 1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
ActiveDocument.Sections(lngSect).Headers(wdHeaderFooterPrimary).LinkToPrevi ous = False
'Ensure that the sectiosn either side of the inserted page have the same headers
ActiveDocument.Sections(lngSect).Headers(wdHeaderFooterPrimary).Range = ActiveDocument.Sections(lngSect - 2).Headers(wdHeaderFooterPrimary).Range
'Remove the header from the new page
ActiveDocument.Sections(lngSect - 1).Headers(wdHeaderFooterPrimary).Range.Text = ""
'Move the range to the new section
Set oRng = ActiveDocument.Sections(lngSect - 1).Range
'Collapse the range to the start of that section
oRng.Collapse 1
'Add the text
oRng.Text = "Now is the time"
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

Thank you - I think this will solve my problem.

Sam Murr