Header Shape Range Madness

[Greg Maxey]

I am still trying, yet failing miserably, to get my head around an efficient
process to add a unique "AddTextEffect" to each of the three header types in
a document.

Using Word2003 and a new blank document, I have used Page Setup to create a
different first page header, and differnent Odd/Even page headers. In each
header, for testing, I have typed in the header type (e.g., "First Page" in
the first page header).

Stating in Print Layout View with the selection in the First Page Header, I
run the following code. This in fact adds three different AddTextEffect
shapes, but all three are stacked on top of each other in the FirstPage
Header. I can't seem to find a way (without first using a canvas shape
which I don't want to do) to insert the shape in the specific header
storyRange as the code indicates it should be doing.

Any ideas?

I have also included some code to speed up deleting the texteffect during
testing.

Thanks.


Option Explicit
Dim i As Long
Dim oShape As Shape
Dim pStr As String
Sub InsertTextEffect()
Dim oHdr As HeaderFooter
Dim oCanvas As Shape
Dim oRng As Word.Range
System.Cursor = wdCursorWait
For i = 1 To 3
Select Case i
Case 1
pStr = "Primary Hdr"
Case 2
pStr = "Even Pages Hdr"
Case 3
pStr = "First Page Hdr"
End Select
Set oHdr = Nothing
Set oHdr = ActiveDocument.Sections(1).Headers(i)
Set oRng = oHdr.Range
'Added for testing to see if the Range is actually where I think it is.
'MsgBox oRng.Text
oRng.Collapse wdCollapseEnd
Set oShape = oHdr.Shapes.AddTextEffect(msoTextEffect1, _
pStr, "Arial", 1, False, False, 0, 0, oRng)
With oShape
.Rotation = 0
.LockAspectRatio = True
.Height = 96
.RelativeHorizontalPosition = wdRelativeVerticalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = wdShapeCenter
.Top = wdShapeCenter
.Name = "Header Watermark " & i
.TextEffect.NormalizedHeight = False
End With
Next i
System.Cursor = wdCursorNormal
End Sub

Sub RemoveTextEffect()
On Error Resume Next
For i = 1 To 3
For Each oShape In ActiveDocument.Sections(1).Headers(i).Shapes
If InStr(oShape.Name, "Header Watermark") > 0 Then
oShape.Delete
End If
Next oShape
Next i
On Error GoTo 0
Application.ScreenRefresh
End Sub

 

[DebsPink]

I am having a very similar problem. We have code which creates a letterhead
and puts a logo in each of the three headers, deleting any existing ones if
necessary. This is all working fine in Office 2003, however since updating
the templates and addin to Office 2007, Word crashes every time on the
..delete code, and if we skip that and just insert new logos, we get three in
the first page header as you do.

I have been doing a lot of experimenting and the only thing I've been able
to do to reproduce the 2003 solution, is to insert the logo as an
inlineshape to a bookmark range and then use .convertToShape to allow me to
place it correctly. But it's driving us mad because the code works fine in
2003 and we can find nothing in any forum or Help to advise why this has
changed in 2007.