Strange section header/footer problems

[JSM]

Hi,

I have inheritied an old macro which adds a document footer at the bottom of
each page (see below). The problem is, just recently we have started getting
two or three footers in each section. I've tried to get around this by
checking if the selected section is either the first section or is linked to
previous. If it is not linked to previous or is the first section then the
footer should be inserted.

The problem is this:

1. Selection.Sections(1).Index always returns "1" when the selection is in a
footer.
2. LinkToPrevious returns "True" for the first section, even though it is
not (because it can't be). The weird thing about this one is that if you
display a message box showing the value of
Selection.HeaderFooter.LinkToPrevious it returns "True", however if you
place a breakpoint at this line and check the value in the Immediate window
it returns "False". If you test this value in an IF statement within the
code it returns "True".

Can somebody please tell me what's going on !!!

The code is below. I acknowledge that the coding is a bit sloppy but like I
said - I have inherited this code and haven't had time to rewrite it:

Dim myRange As Range
Dim intSections As Integer

'Inserts docref 8 points left aligned adjust alignment etc as required the
first place it
'has been inserted and the next section - where it is inserted from
thereafter.


On Error GoTo errorhandler 'close footer - return to main doc

'ensure doc is in page view
ActiveWindow.ActivePane.View.Type = wdPageView

'ensure top first page
Selection.HomeKey Unit:=wdStory

'edit first page footer
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

'search for non breaking space in first page footer, if not exist insert
docref
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Text = "^s"
.Replacement.Text = ""
.Forward = True
End With

If Selection.Find.Execute = False Then
Selection.WholeStory 'text in footer insert extra return b4
inserting ref
If Selection <> vbCr Then
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Else 'no text in footer - dont insert extra paramark
Selection.EndKey Unit:=wdStory
End If

Selection.ParagraphFormat.TabStops.ClearAll
Selection.Font.Size = 9
Dim myrng As Range
Set myrng = Selection.Range
myrng.End = Selection.Range.End
myrng.Start = Selection.Range.Start

If ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
Then

ThisDocument.AttachedTemplate.AutoTextEntries("WTFoot_NoPg").Insert myrng,
True
Else
ThisDocument.AttachedTemplate.AutoTextEntries("WTFoot").Insert
myrng, True
Selection.ParagraphFormat.TabStops.Add
(Selection.PageSetup.PageWidth - Selection.PageSetup.RightMargin -
Selection.PageSetup.LeftMargin), wdAlignTabRight
End If
Selection.Collapse wdCollapseStart
End If

'search through remaining sections
On Error Resume Next

Do
'goto next header and check for docref, ie next footer same as previous

ActiveWindow.ActivePane.View.NextHeaderFooter

If Err = 4605 Then
Exit Do
End If


If Selection.HeaderFooter.LinkToPrevious = False Then
'search for non breaking space, if not exist insert docref
With Selection.Find
.ClearFormatting
.Text = "^s"
.Replacement.Text = ""
.Forward = True
End With

If Selection.Find.Execute = False Then
Selection.WholeStory 'text in footer insert extra return b4
inserting ref
If Selection <> vbCr Then
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Else 'no text in footer - dont insert extra paramark
Selection.EndKey Unit:=wdStory
End If

Selection.ParagraphFormat.TabStops.ClearAll
Selection.Font.Size = 9

ThisDocument.AttachedTemplate.AutoTextEntries("WTFoot").Insert
Selection.Range, True
Selection.ParagraphFormat.TabStops.Add
(Selection.PageSetup.PageWidth - Selection.PageSetup.RightMargin -
Selection.PageSetup.LeftMargin), wdAlignTabRight
Selection.Collapse wdCollapseStart
End If
End If
Loop

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Exit Sub

errorhandler:
MsgBox "Error: " & Err.Number & vbNewLine & Err.Description
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

 

[Jezebel]

YUK. It will be quicker to start again than to try to patch up and maintain
this code.

First, what is the macro actually supposed to do? Delete any existing
footers and add a new one? The original writer seems to have lost the plot.

Second, forget all this mucking around with selections and windows. It is
MUCH easer and quicker to iterate the sections and footers directly ...

For each pSection in ActiveDocument.Sections
For each pFooter in pSection.Footers
.... etc

 

[JSM]

I've bitten the bullet and am rewriting the macro. However I have come
across a couple of problems:

1. The current macro looks for a non-breaking space within the footer. If it
finds one then it doesn't insert the document reference. The old macro did a
find on the Selection object looking for "^s". However since I am now
performing the find on the Range object of the footer it is not finding it.
How can I look for a non-breaking space within a footer without actually
placing the cursor inside the footer?

2. I need to add a right-aligned tab against the right margin in the footer.
The original code to do this was:

Selection.ParagraphFormat.TabStops.Add (Selection.PageSetup.PageWidth -
Selection.PageSetup.RightMargin - Selection.PageSetup.LeftMargin),
wdAlignTabRight

I have replaced "Selection" with a range object pointing to the footer's
range. However when I run this code I get an error

4605: This method or property is not available because the current selection
is not in the main document window.

Any help with these issues will be appreciated.

Cheers,

John

 

[JSM]

Don't worry I figured out both problems (not without some pain !).

1. for some reason if I create a new range object and set it to the footer's
range, then do the find on the range object it works. I would have thought
it would still work by doing the find directly on the footers range (ie
myFoot.Range.Find) but it doesn't.

2. I got around the tab problem by referring to the page setup and paper
width of the current section as opposed to the current footer.

Cheers,

John