Creating Header / Footer pages in a loop !

[Grenier]

Automating a word report from access. Having problem with Header and Footer
when looping throught the recordset. I must create 1 page for each record and
each page must have it's owned Head/Foot. Note that the first page is OK but
an error occur on the second page. The sample code use an array instead of a
recordset.

sub test()

MyArray = Split("aaaa bbbb cccc dddd eeee ffff")

Set wrd = CreateObject("Word.Application")
Set doc = wrd.Documents.Add
wrd.Visible = True

For x = 0 To UBound(MyArray)
Set Tbl = wrd.ActiveDocument.Tables.Add(wrd.Selection.Range, 1, 2)
With Tbl
Set Rng = .Cell(1, 1).Range
Rng.Text = MyArray(x)
End With

CurIndex = wrd.Selection.Sections(1).Index
wrd.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True

wrd.ActiveDocument.Sections(CurIndex).Headers(wdHeaderFooterFirstPage).LinkToPrevious = False

Set Rng =
wrd.ActiveDocument.Sections(CurIndex).Headers(wdHeaderFooterFirstPage).Range
Set TblHeader = Rng.Tables.Add(Range:=Rng, numrows:=1, numcolumns:=2)
With TblHeader
Set Rng = .Cell(1, 1).Range
Rng.Text = "Header for " & MyArray(x)
Set Rng = .Cell(1, 2).Range
Rng.Text = "Header"
End With


wrd.ActiveDocument.Sections(CurIndex).Footers(wdHeaderFooterFirstPage).LinkToPrevious = False
Set Rng =
wrd.ActiveDocument.Sections(CurIndex).Footers(wdHeaderFooterFirstPage).Range
Set TblFooter = Rng.Tables.Add(Range:=Rng, numrows:=1, numcolumns:=2)
With TblFooter
Set Rng = .Cell(1, 1).Range
Rng.Text = "Footer for " & MyArray(x)
Set Rng = .Cell(1, 2).Range
Rng.Text = "Footer"
End With

Tbl.Select
With wrd.Selection
.Move wdCharacter, 1 ' get past table marker
.InsertBreak Type:=wdSectionBreakNextPage
.Goto What:=wdGoToPage, Which:=wdGoToNext
End With

Next x

End Sub

Merci !

 

[Doug Robbins - Word MVP]

What do you mean by "an error occur on the second page". What does or does
not happen?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Grenier]

The error message is (french: # 6028 Impossible de supprimer la plage): " #
6028 impossible to delete range" . This message is displayed when the macro
try to set the header for the second page. There is no problem on the first
pass of the for/next, so header and footer on first page 'aaaa' are OK but
the macro is stopped with this error when it try to set Header on page 'bbbb'.

I'm using this sub on an Access 2002 module with of course reference to word
10.0 object library.

 

[fumei via OfficeKB.com]

For one thing, CurIndex is not incremented. You may want to try using a
HeaderFooter object to do your head and footer work. try this. I moved the
CurIndex initializing out of the loop, as well as the DifferentFirstPage. If
DifferentFirstPage is to apply for all Sections, you may as well do once, at
the beginning. It should apply for the entire document.

There is no need to set a range object for the table in the document. Just
put the text into the cells.


Sub test()
Dim MyArray()
Dim Tbl As Word.Table
Dim oHF As Word.HeaderFooter
Dim CurIndex As Long
MyArray = Split("aaaa bbbb cccc dddd eeee ffff")

Set wrd = CreateObject("Word.Application")
Set doc = wrd.Documents.Add
wrd.Visible = True

CurIndex = 1
wrd.ActiveDocument.PageSetup _
.DifferentFirstPageHeaderFooter = True

For x = 0 To UBound(MyArray)
Set Tbl = wrd.ActiveDocument.Tables _
.Add(wrd.Selection.Range, 1, 2)
Tbl.Cell(1, 1).Range.Text = MyArray(x)

' action Header as object
Set oHF = wrd.ActiveDocument.Sections(CurIndex) _
.Headers(wdHeaderFooterFirstPage)
With oHF
.LinkToPrevious = False
.Range.Tables _
.Add Range:=oHF.Range, numrows:=1, numcolumns:=2
.Range.Tables(1).Cell(1, 1).Range _
.Text = "Header for " & MyArray(x)
.Range.Tables(1).Cell(1, 2).Range _
.Text = "Header"
End With

' action Footer as object
Set oHF = wrd.ActiveDocument.Sections(CurIndex) _
.Footers(wdHeaderFooterFirstPage)
With oHF
.LinkToPrevious = False
.Range.Tables _
.Add Range:=oHF.Range, numrows:=1, numcolumns:=2
.Range.Tables(1).Cell(1, 1).Range _
.Text = "Footer for " & MyArray(x)
.Range.Tables(1).Cell(1, 2).Range _
.Text = "Footer"
End With

' go to end of document
With wrd.Selection
.EndKey Unit:=6 ' this is wdStory
.InsertBreak Type:=wdSectionBreakNextPage
' Selection will move into that Section
' so Set Tbl using wrd.Selection should work
End With
' increment CurIndex
CurIndex = CurIndex + 1
Next x

End Sub

The error message is (french: # 6028 Impossible de supprimer la plage): " #
6028 impossible to delete range" . This message is displayed when the macro
try to set the header for the second page. There is no problem on the first
pass of the for/next, so header and footer on first page 'aaaa' are OK but
the macro is stopped with this error when it try to set Header on page 'bbbb'.

I'm using this sub on an Access 2002 module with of course reference to word
10.0 object library.

What do you mean by "an error occur on the second page". What does or does
not happen?

[quoted text clipped - 64 lines]

 

[Grenier]

I agree with your comment Fumei
Thought that CurIndex would increment on each SectionBreak.

Tried your code but sadly still having the same error. I've cut and paste
the sub to an Access module with option explicit, add a few object but cannot
figure out why ?

Sub test()
Dim wrd As Word.Application
Dim doc As Word.Document
Dim MyArray As Variant
Dim Tbl As Word.Table
Dim oHF As Word.HeaderFooter
Dim CurIndex As Long
Dim x As Integer

MyArray = Split("aaaa bbbb cccc dddd eeee ffff")

Set wrd = CreateObject("Word.Application")
Set doc = wrd.Documents.Add
wrd.Visible = True

CurIndex = 1
wrd.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True

For x = 0 To UBound(MyArray)
Set Tbl = wrd.ActiveDocument.Tables.Add(wrd.Selection.Range, 1, 2)
Tbl.Cell(1, 1).Range.Text = MyArray(x)

' action Header as object
Set oHF =
wrd.ActiveDocument.Sections(CurIndex).Headers(wdHeaderFooterFirstPage)
With oHF
.LinkToPrevious = False
.Range.Tables.Add Range:=oHF.Range, numrows:=1, numcolumns:=2
.Range.Tables(1).Cell(1, 1).Range.Text = "Header for " & MyArray(x)
.Range.Tables(1).Cell(1, 2).Range.Text = "Header"
End With

' action Footer as object
Set oHF =
wrd.ActiveDocument.Sections(CurIndex).Footers(wdHeaderFooterFirstPage)
With oHF
.LinkToPrevious = False
.Range.Tables.Add Range:=oHF.Range, numrows:=1, numcolumns:=2
.Range.Tables(1).Cell(1, 1).Range.Text = "Footer for " & MyArray(x)
.Range.Tables(1).Cell(1, 2).Range.Text = "Footer"
End With

' go to end of document
With wrd.Selection
.EndKey Unit:=6 ' this is wdStory
.InsertBreak Type:=wdSectionBreakNextPage
' Selection will move into that Section
' so Set Tbl using wrd.Selection should work
End With
' increment CurIndex
CurIndex = CurIndex + 1
Next x

End Sub