Replacing AutoText entries in Headers

[Roderick O'Regan]

I have a template which consists of the first page with a "First Page
Header". The second and subsequent pages, when they are used but which
are not yet visible, will have ordinary "Headers".

In the first page header and in the header there are AutoText entrries
consisting of coloured shapes (red ones to start with).

I want to delete these and replace them with green AutoText shapes
whilst I have the first page showing but not any other pages as yet.
(By the way, there are a couple of other logos on these pages which I
want to keep at all times).

I use the following procedure to delete the red coloured shapes from
both the first page and the second (which is still not visible):
*****************************
Public Sub DeleteShapes()
'delete each shape in primary headers/footers which meets certain
criteria
Dim wDoc As Word.Document
Dim shps As Shapes
Set wDoc = ActiveDocument
For x = 1 To wDoc.Sections.Count
If
Doc.Sections(x).Headers(wdHeaderFooterPrimary).Shapes.Count> 0 Then
Set shps =
wDoc.Sections(x).Headers(wdHeaderFooterPrimary).Shapes
For i = shps.Count To 1 Step -1
'delete the shape which is less than 3.8cm wide - the red one
If shps(i).Width < CentimetersToPoints(3.8) Then
shps(i).Delete
End If
Next i
End If
Next
End Sub
**************************************
If I want to replace the exisiting red shapes with green ones I use
the following procedure but only AFTER I have a second page visible
otherwise it will only put it on the first page:
============================
Public Sub AddGreenBox1()
'first delete the existing shape
DeleteShapes

'then add new box
ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageHeader
ActiveDocument.AttachedTemplate.AutoTextEntries("green") _
.Insert Where:=Selection.Range, RichText:=True

'Put here to trap the error if no second page is visible
On Error GoTo QuitHere1
ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryHeader
ActiveDocument.AttachedTemplate.AutoTextEntries("green") _
.Insert Where:=Selection.Range, RichText:=True

QuitHere1:
'return to main document
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub
==========================
I've been trying to fathom out a procedure which follows the principle
of the first one above i.e. if I can delete all the red boxes from
headers even though the first page is not showing, why can't I seem to
reverse the procedure and have VBA put the green ones IN?

Hence my second code section above to overcome my lack of knowledge.
It works OK but not until I have a second page.

I'm sure that Ranges comes into play somewhere but I cannot find the
right combination.

Could someone help me with this, please?

Roderick

 

[Cindy M -WordMVP-]

Hi Roderick,

Since you're using AutoText entries, I'd be inclined to insert these as
AutoText FIELDS. You should then be able to change the CODE property of
the field(s) in the appropriate ranges to display whichever you
want/need.

As a matter of fact, if this is always total-page-number based, you
could probably even manage with a IF field, and not VBA code at all.
along the lines of

{ AUTOTEXT { IF { Numpages } = 1 "NameOfEntry" "NameOfEntry" } }

I have a template which consists of the first page with a "First Page
Header". The second and subsequent pages, when they are used but which
are not yet visible, will have ordinary "Headers".

In the first page header and in the header there are AutoText entrries
consisting of coloured shapes (red ones to start with).

I want to delete these and replace them with green AutoText shapes
whilst I have the first page showing but not any other pages as yet.
(By the way, there are a couple of other logos on these pages which I
want to keep at all times).

I use the following procedure to delete the red coloured shapes from
both the first page and the second (which is still not visible):
*****************************
Public Sub DeleteShapes()
'delete each shape in primary headers/footers which meets certain
criteria
Dim wDoc As Word.Document
Dim shps As Shapes
Set wDoc = ActiveDocument
For x = 1 To wDoc.Sections.Count
If
Doc.Sections(x).Headers(wdHeaderFooterPrimary).Shapes.Count> 0 Then
Set shps =
wDoc.Sections(x).Headers(wdHeaderFooterPrimary).Shapes
For i = shps.Count To 1 Step -1
'delete the shape which is less than 3.8cm wide - the red one
If shps(i).Width < CentimetersToPoints(3.8) Then
shps(i).Delete
End If
Next i
End If
Next
End Sub
**************************************
If I want to replace the exisiting red shapes with green ones I use
the following procedure but only AFTER I have a second page visible
otherwise it will only put it on the first page:
============================
Public Sub AddGreenBox1()
'first delete the existing shape
DeleteShapes

'then add new box
ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageHeader
ActiveDocument.AttachedTemplate.AutoTextEntries("green") _
.Insert Where:=Selection.Range, RichText:=True

'Put here to trap the error if no second page is visible
On Error GoTo QuitHere1
ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryHeader
ActiveDocument.AttachedTemplate.AutoTextEntries("green") _
.Insert Where:=Selection.Range, RichText:=True

QuitHere1:
'return to main document
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub
==========================
I've been trying to fathom out a procedure which follows the principle
of the first one above i.e. if I can delete all the red boxes from
headers even though the first page is not showing, why can't I seem to
reverse the procedure and have VBA put the green ones IN?

Hence my second code section above to overcome my lack of knowledge.
It works OK but not until I have a second page.

I'm sure that Ranges comes into play somewhere but I cannot find the
right combination.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail

 

[Roderick O'Regan]

Thank you Cindy for your helpful ideas.

I'll try working with the AutoText fields angle.

In this case the IF field is not appropriate. However, there's
something there I learnt - how to use an IF statement with an AutoText
entry.

Thanks again for your help.

Roderick