Consulting

Results 1 to 3 of 3

Thread: Trouble with LinkToPrevious

  1. #1
    VBAX Regular
    Joined
    Jul 2018
    Location
    Blanchard
    Posts
    7
    Location

    Trouble with LinkToPrevious

    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

  2. #2
    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).LinkToPrevious = 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
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Jul 2018
    Location
    Blanchard
    Posts
    7
    Location

    Thanks - I think this will solve my issues.

    Quote Originally Posted by gmayor View Post
    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).LinkToPrevious = 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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •