Adding line to headers in Word 2010

[smccaffr39]

hello all. i have this code that i have an issue with:



Private Sub AddLines()
With ActiveDocument
With .PageSetup
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.DifferentFirstPageHeaderFooter = True
.OddAndEvenPagesHeaderFooter = True
End With
With .Sections(1)
.Headers(wdHeaderFooterFirstPage).Shapes.AddLine BeginX:=InchesToPoints(0.75 - 0.08), _
BeginY:=InchesToPoints(1), EndX:=InchesToPoints(0.75 + 7 + 0.08), EndY:=InchesToPoints(1)
.Headers(wdHeaderFooterPrimary).Shapes.AddLine BeginX:=InchesToPoints(0.75 - 0.08), _
BeginY:=InchesToPoints(1), EndX:=InchesToPoints(0.75 + 7 + 0.08), EndY:=InchesToPoints(1)
End With
End With
End Sub


i've included the addition to aid in the interpretation. ideally, it should a line that starts .08" to the left of the text margin and is 7.16" long to both the first page and primary/3rd page.

the problem is that in Word 2010, it adds the line to the primary page header twice. no idea why. i've tried it on 2 different computers, though, they are using the same normal.dotm. in 2013, this code adds the line to each the first page and primary (3rd) page. any help with would be much appreciated!

[gmayor]

The following works in Word 2010 and later

Option Explicit
Private Sub AddLines()
Dim oHeader As HeaderFooter
With ActiveDocument
With .PageSetup
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.DifferentFirstPageHeaderFooter = True
.OddAndEvenPagesHeaderFooter = True
End With
With .Sections(1)
For Each oHeader In .Headers
oHeader.Shapes.AddLine _
BeginX:=InchesToPoints(0.75 - 0.08), _
BeginY:=InchesToPoints(1), _
EndX:=InchesToPoints(0.75 + 7 + 0.08), _
EndY:=InchesToPoints(1)
Next oHeader
End With
End With
lbl_Exit:
Set oHeader = Nothing
Exit Sub
End Sub

[gmaxey]

Your code works fine here with Word 2010.

Graham, here your code add the line to all First, Even and Primary (page 3). I think the OP only wants the line on the fist and primary pages.

[smccaffr39]

thanks all. yes, that's correct, i need it on the first and primary pages, but it appears i have a bigger issue. i thought that my code should work. there's not much to it. i tried Graham's code and it does the same thing, puts all the lines in one spot. very strange. i tried another computer at work and got the same result. obviously there's something else going on. i'm able to add pictures and have them appear in the right header. i suppose i can try setting a range, adding a line as an inlineshape, then converting it. if you can think of anything else, a setting maybe, let me know. thanks!

[gmayor]

Your code sets not only the different first page, but odd and even pages, so the code I posted will address all three headers in Section 1. If you want it in only some of the headers then you need to change the code to address only those headers. The following also works in Word 2010, but I have added a range to the end of the header for the anchor and limited the line to only the first page and the primary.

With the .OddAndEvenPagesHeaderFooter option set to True, the primary header applies to the even pages only. If you want both odd and even pages, set the .OddAndEvenPagesHeaderFooter value to False.


Option Explicit

Private Sub AddLines()
Dim oHeader As HeaderFooter
Dim oRng As Range
With ActiveDocument
With .PageSetup
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.DifferentFirstPageHeaderFooter = True
.OddAndEvenPagesHeaderFooter = True
End With
With .Sections(1)
For Each oHeader In .Headers
Set oRng = oHeader.Range
oRng.Collapse direction:=wdCollapseEnd
Select Case oHeader.Index
Case Is = wdHeaderFooterFirstPage, wdHeaderFooterPrimary
oHeader.Shapes.AddLine _
BeginX:=InchesToPoints(0.75 - 0.08), _
BeginY:=InchesToPoints(1), _
EndX:=InchesToPoints(0.75 + 7 + 0.08), _
EndY:=InchesToPoints(1), _
Anchor:=oRng
Case Is = wdHeaderFooterEvenPages
'do nothing
End Select
Next oHeader
End With
End With
lbl_Exit:
Set oHeader = Nothing
Set oRng = Nothing
Exit Sub
End Sub