Creating Header / Footer pages in a loop !  
Author Message
Alison





PostPosted: Wed Feb 27 02:10:37 PST 2008 Top

MS Word VBA >> Creating Header / Footer pages in a loop !

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 !

Word298  
 
 
Doug





PostPosted: Wed Feb 27 02:10:37 PST 2008 Top

MS Word VBA >> Creating Header / Footer pages in a loop ! 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



> 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 !
>
>


 
 
Grenier





PostPosted: Wed Feb 27 05:25:01 PST 2008 Top

MS Word VBA >> Creating Header / Footer pages in a loop ! 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?
>
> --
> 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
>


> > 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 !
> >
> >
>
>
>
 
 
fumei





PostPosted: Wed Feb 27 12:28:54 PST 2008 Top

MS Word VBA >> Creating Header / Footer pages in a loop ! 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]
>> >
>> > Merci !

--
Message posted via http://www.officekb.com

 
 
Grenier





PostPosted: Wed Feb 27 18:08:00 PST 2008 Top

MS Word VBA >> Creating Header / Footer pages in a loop ! 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

------------------------------------


> 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.