Inserting Shapes in all Headers - Watermarks- "Draft"

[Kerri]

I am in desperate need of another pair of eyes. I am
working in Word 2000 and have a macro that creates a
Watermark using wordart. This is the 3rd version. The
previous version worked find as long as there wasn't
sections or Diff. first page. So, in this version I have
incorporated oSection and oHeader to have it loop through
each section of the document. Which works great when
there 'are' multiple sections.

Problem: I have a lot of documents with Different first
page marked and it might or might not have additional
sections. In this situation it only puts the watermark on
a single page or makes the 1st page correct and all other
pages dont have my formatting of the wordart object. It
could be just a placement thing...I just don't know.

Perv. version - i named the shape .name = "draft1" in this
version it is not possible to name the shape so you can
delete "only" that shape.

I am a novice...and learn by trial and error as well as
searching all the news groups. The "oSection" options I
added came from this posting: 7-2-2001
microsoft.public.word.vab.general Subject:NextHeaderFooter

Any help is greatly appreciated.
Thank you!


Sub DRAFTWaterMark()
Dim i As Integer
Dim oSection As Section, oHeader As HeaderFooter, oShape
As Shape, MyRange As Range

' AddTextEffect fails unless the view is in the header:
ActiveWindow.View.Type = wdPageView
Selection.EndKey Unit:=wdStory
' ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.SeekView =
wdSeekFirstPageHeader

For Each oSection In ActiveDocument.Sections
For Each oHeader In oSection.Headers
If oHeader.Exists Then
Set MyRange = oHeader.Range

oHeader.Shapes.AddTextEffect
(msoTextEffect8, "Draft Copy", _
"Times New Roman", 36#, msoFalse,
msoFalse, 226.3, 157.7, MyRange).Select

With oHeader.Range.ShapeRange
If .Count >= 1 Then 'This makes the first
page different than the rest of the pages??
.Fill.Solid
.Fill.ForeColor.RGB = RGB(192, 192, 192)
'Lighter Grey color
'.Fill.ForeColor.RGB = RGB(221, 221, 221)
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoFalse
.LockAspectRatio = msoFalse
.Height = 81.35
.Width = 360#
.Rotation = 0#
.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = _
wdRelativeVerticalPositionPage
.Left = wdShapeCenter
.Top = wdShapeCenter
.LockAnchor = True
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.WrapFormat.DistanceTop = InchesToPoints(0)
.WrapFormat.DistanceBottom = InchesToPoints
(0)
.WrapFormat.DistanceLeft = InchesToPoints
(0.13)
.WrapFormat.DistanceRight = InchesToPoints
(0.13)
.WrapFormat.Type = 3
.ZOrder 5
.Shadow.Visible = msoFalse
End If
End With
End If
Next oHeader
Next oSection

ActiveWindow.ActivePane.View.SeekView =_
wdSeekMainDocument

End Sub
'--------------
Sub DeleteDraftWatermark()

'I would like it to delete only the shapes inserted
above...but no such luck.

For Each Section In ActiveDocument.Sections
For Each header In Section.Headers
For Each Shape In header.Shapes
Shape.Delete
Next
Next
Next
End Sub

 

[Jezebel]

There's a much easier way to get to all the headers, that means you don't
have to worry about what sections the document might be divided into. All
the content in a document is in the various storyrange collections. These
are essentially linked lists of Range objects, containing the main story,
headers, footers, textbox text, etc. The ones you are interested in are:
wdPrimaryHeaderStory, wdFirstPageHeaderStory, and wdEvenPagesHeaderStory.

You can loop through all the headers using code like this:

Dim pRange as Word.Range
Dim pRange2 as Word.Range
Dim pHeaderType as Word.WdStoryType
Dim pIndex as long


For pIndex = 1 to 3

'Get the first header of the given type
pHeaderType = Choose(pIndex, wdPrimaryHeaderStory, _

wdFirstPageHeaderStory, _

wdEvenPagesHeaderStory)
set pRange = ActiveDocument.StoryRanges(pHeaderType)

'Loop through all the headers of this type
Set pRange2 = pRange
Do until pRange2 is nothing

---- Add your watermark to pRange2 here ---

'Get the next header of this type
set pRange2 = pRange2.Next
Loop

Next

 

[Kerri]

Thank you Jezabel for taking the time to reply. I feel
foolish to ask but, I don't understand story ranges. And
when I read the help files my head spins. Why is it you
can assign the property of pRange to Word.Range? But
can't use Word.Range when your are not assigning it?

(sorry, I have taken 1 3-day course in VB 6.0 and the rest
is from trial & error and newsgroups)

So, I did try...not sure if all my ducks are in a
row..but,I got an error on:

set pRange = ActiveDocument.StoryRanges(pHeaderType)
"requested member of the collection does not exist"


Here is the code: I marked questions with '(k)
Sub DraftWatermark()

Dim pRange As Word.Range
Dim pRange2 As Word.Range
Dim pHeaderType As Word.WdStoryType
Dim pIndex As Long


For pIndex = 1 To 3

'Get the first header of the given type
'(K)I put this all on one line.
pHeaderType = Choose(pIndex, wdPrimaryHeaderStory,_
wdFirstPageHeaderStory, wdEvenPagesHeaderStory)_

'(k)This is where the error occures
Set pRange = ActiveDocument.StoryRanges(pHeaderType)

'Loop through all the headers of this type
Set pRange2 = pRange
Do Until pRange2 Is Nothing

' ---- Add your watermark to pRange2 here ---

'(k)Not sure if ActiveDocument.AddTextEffect is correct
'anymore since I'm not using the oSection and oHeader.

ActiveDocument.AddTextEffect(msoTextEffect8,_
"Draft Copy", "Times New Roman", 36#, _
msoFalse, msoFalse,_
226.3, 157.7, MyRange).Select
'What about "MyRange" this is how I "Anchor" it to the
header??

With Selection.ShapeRange
.Fill.Solid
.Fill.ForeColor.RGB = RGB(192, 192, 192)
'Lighter Grey color
'.Fill.ForeColor.RGB = RGB(221, 221, 221)
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoFalse
.LockAspectRatio = msoFalse
.Height = 81.35
.Width = 360#
.Rotation = 0#
.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = _
wdRelativeVerticalPositionPage
.Left = wdShapeCenter
.Top = wdShapeCenter
.LockAnchor = True
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.WrapFormat.DistanceTop = InchesToPoints(0)
.WrapFormat.DistanceBottom = InchesToPoints(0)
.WrapFormat.DistanceLeft = InchesToPoints(0.13)
.WrapFormat.DistanceRight =InchesToPoints(0.13)
.WrapFormat.Type = 3
.ZOrder 5
.Shadow.Visible = msoFalse
End With


'Get the next header of this type
Set pRange2 = pRange2.Next
Loop

Next


End Sub

 

[Jezebel]

Thank you Jezabel for taking the time to reply. I feel
foolish to ask but, I don't understand story ranges. And
when I read the help files my head spins.

These are fairly big questions and there are web sites that explain it
better than I can: try Google on any of the terms that puzzle you. Briefly,
a Range is any stretch of document. The Selection object is a range.
Anywhere in your code that you refer to the Selection you could instead use
a range variable.

The document as a whole comprises a set of ranges called StoryRanges. You
always have the MainStory - the body of the document, plus whatever other
types of matter you've added - headers, footers, textboxes, footnotes and I
can't remember what else. The types other than MainStory may contain any
number of sub-ranges - eg headers for successive sections if they are not
'Same as previous'.

Set pRange = StoryRanges(type)

gets you the first sub range of that type, if it exists (eg FirstPageHeader,
section 1)

Set pRange = pRange.Next

gets you the next in the series (eg FirstPageHeader, section 2). You've
reached the end of the list when .Next is nothing.


When you get this error:

set pRange = ActiveDocument.StoryRanges(pHeaderType)
"requested member of the collection does not exist"

it means your document doesn't have a header of that type. You can trap the
error and add your own header using

ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text =
"[Header text]"

Note that the indexes for Headers() and Footers() are different to those for
StoryRanges().



Why is it you

can assign the property of pRange to Word.Range? But
can't use Word.Range when your are not assigning it?

pRange is an object variable. Word.Range is its type. That means that the
definition of the object - its properties, methods, and events - is in the
Word code library. Look at the Object Browser (on the VBA View menu).

 

[Guest]

Jezebel,

Sorry, it took me so long to respond, I have been giving
it a try with no luck. Thank you again for helping me. My
comment is below with (KB) - to mark it. The explination
of the code helped a little. Thanks! =)

-----Original Message-----



These are fairly big questions and there are web sites that explain it
better than I can: try Google on any of the terms that puzzle you. Briefly,
a Range is any stretch of document. The Selection object is a range.
Anywhere in your code that you refer to the Selection you could instead use
a range variable.

The document as a whole comprises a set of ranges called StoryRanges. You
always have the MainStory - the body of the document, plus whatever other
types of matter you've added - headers, footers, textboxes, footnotes and I
can't remember what else. The types other than MainStory may contain any
number of sub-ranges - eg headers for successive sections if they are not
'Same as previous'.

Set pRange = StoryRanges(type)

gets you the first sub range of that type, if it exists (eg FirstPageHeader,section 1)

(KB) - If this gets the first range why do I have to trap
the error with the code below? Isn't this like saying
tell me the name of the first sections header....then the
next section uses that "type" and inserts the
watermark....then goes gets the next header range...and so
on?

Set pRange = pRange.Next

gets you the next in the series (eg FirstPageHeader,
section 2). You've reached the end of the list when .Next
is nothing.


When you get this error:

set pRange = ActiveDocument.StoryRanges(pHeaderType)
"requested member of the collection does not exist"

it means your document doesn't have a header of that

type. You can trap the error and add your own header using

ActiveDocument.Sections(1).Headers
(wdHeaderFooterFirstPage).Range.Text =
"[Header text]"

(KB) -Hi Jezebel, Where do I put the above code? I want
the "[header text]" to be the WordArt. I must be getting
in over my head because I'm a little more lost with this
coded than I was with the first macro....just because I
have very little experience. (