wdGoToAbsolute not working correctly

W

Wes

I'm having problems with headers/footers that are linked to previous. My
test document is a document with 4 sections, with the section footer 2 linked
to 1 and section footer 4 linked to 3.

When I run this, moving to the section 2, moving to the footer puts me up in
the footer for section 1, which is fine as 2 is linked to one. However, the
next iteration moves to section 3, then moving to the footer puts me in the
footer for section 2, where my insert is duplicated.

Any help would be appreciated. Thanks.

Here is the code:
SecCt = ActiveWindow.ActivePane.Document.Sections.Count
Err.Clear
For s = 1 To SecCt 'Loop through the sections 1.1
Selection.GoTo what:=wdGoToSection, which:=wdGoToAbsolute, Count:=s
'Move focus to next section
For h = 1 To 3 'three header types
Select Case h '1.1.1
Case 1
ActiveWindow.ActivePane.View.SeekView =
wdSeekPrimaryFooter
Case 2
ActiveWindow.ActivePane.View.SeekView =
wdSeekFirstPageFooter
Case 3
ActiveWindow.ActivePane.View.SeekView =
wdSeekEvenPagesFooter
End Select 'End 1.1.1
If Err.Number = 5895 Then 'Check if footer type exists '1.1.2
Err.Clear
Else '1.1.2
With Selection '1.1.2.1
i = 0
If
(ActiveDocument.Sections(s).Footers(h).LinkToPrevious) = True Then
doInsert = False
Else
doInsert = True
Do
.MoveRight unit:=wdSentence, Extend:=wdExtend
If .Find.Execute(FindText:=OrigDocID,
ReplaceWith:=NewVersion, Replace:=wdReplaceAll) = True Then
doInsert = False
.Font.Name = "Arial"
.Font.Size = 8
End If
.MoveDown
i = i + 1
Loop Until Selection.HeaderFooter.IsHeader = True Or
i = 5
End If
If doInsert Then
.HomeKey
.MoveUp
If Selection.HeaderFooter.IsHeader = True Then
.MoveDown
End If
.Font.Name = "Arial"
.Font.Size = 8
.InsertBefore (NewVersion & " ")
End If
End With 'End 1.1.2.1
End If
Next h
Next s 'Loop through the sections 1.1
 
G

Greg Maxey

Rather than attempting to decipher your non-functionin code, could you
simply state what you are trying to achieve?
 
G

Greg Maxey

You might trying avoiding GoTo altogether:

Sub ScratchMacro()
Dim SectCt As Long, s As Long, h As Long, i As Long
Dim doInsert As Boolean
Dim OrigDocID As String, NewVersion As String
Dim oRng As Word.Range
Dim oDoc As Word.Document
Set oDoc = ActiveDocument
SectCt = oDoc.Sections.Count
For s = 1 To SectCt
For h = 1 To 3
Set oRng = oDoc.Sections(s).Headers(h).Range
i = 0
If oDoc.Sections(s).Headers(h).LinkToPrevious Then
MsgBox "Header is linked to previous"
doInsert = False
Else
MsgBox "Header is not linked to previous"
doInsert = True
'Do your loop
End If
If doInsert Then
'Whatever
End If
Next h
Next s
End Sub
 
W

Wes from Scottsdale

I hadn't thought of using Range. Thanks for putting me on the right track.
I needed to iterate through all of the footers in a document and replace the
current document number with a newly assigned number. The Selection.GoTo was
having a problem with the LinkToPrevious; after moving to section 3 and
requesting to go to the footer, it would take me to the footer of section 2
instead. Using Range I was able to replace that section of (functioning)
code with this:
*********************************
For s = 1 To SecCt 'Loop through the sections 1.1
For h = 1 To 3 'three header types
If ActiveDocument.Sections(s).Footers(h).LinkToPrevious = False Then
'Selection.GoTo what:=wdGoToSection, which:=wdGoToAbsolute,
Count:=s 'Move focus to next section
strTemp = ActiveDocument.Sections(s).Footers(h).Range.Text
If InStr(0, strTemp, OrigDocID) Then
strTemp = Replace(strTemp, OrigDocID, NewVersion)
ActiveDocument.Sections(s).Footers(h).Range.Text = strTemp
Else
ActiveDocument.Sections(s).Footers(h).Range.Text = NewVersion
& " " & ActiveDocument.Sections(s).Footers(h).Range.Text
End If
End If
Next h
Next s 'Loop through the sections 1.1
**********************************
Thanks again!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top