Word Dynamic Header/Footer Creation 1

[CPForecast]

Hello,

I have a Word XP macro that I am writing to add some dynamic information to a series of documents. One of the tasks is to recreate the headers and footers of each document based on the information for each specific report. For example, the report title, category, and month and year of publication for each report are pulled from a database and are to be added to the headers and footers. There is a different header and footer for the first page, even pages, and odd pages. We are moving to this new dynamic way up updating the headers and footers from having the information changed manually by the staff here.

I have attached a sample of what one of our documents looks like. I am having a few problems with this task that I can't seem to figure out. I'm far from being an expert VBA programmer, so I'm sure there are more efficient ways to do some of the things I'm trying to do. I looked around other forum posts and was able to solve a few of my problems, but additional assistance or insight to complete this task would be much appreciated. Thanks.

Sub HeadersAndFooters(currentFields, year, Month As String)
Dim ThisDoc As Document
Dim oHF As HeaderFooter
Dim var
Dim HeaderText()
Dim FooterText()
Dim HeaderEven, HeaderOdd, FooterEven
Dim FooterOdd, HeaderFirst, FooterFirst
Dim FullMonth
Dim objSection As Section


ActiveWindow.View.ShowHiddenText = True

FullMonth = monthname(currentFields!PUB_MONTH_INT)

HeaderEven = "Page " + CStr(Selection.Information(wdActiveEndPageNumber)) + vbTab + _
            vbTab + currentFields!BOOK_NAME + vbCrLf + currentFields!REPORT_TITLE
            
HeaderOdd = currentFields!BOOK_NAME + vbTab + vbTab + _
            "Page " + CStr(Selection.Information(wdActiveEndPageNumber)) + vbCrLf + _
            vbTab + vbTab + currentFields!REPORT_TITLE

HeaderFirst = currentFields!BOOK_NAME

FooterEven = FullMonth + " " + year

FooterFirst = "©" + year + vbTab + FullMonth + " " + year

FooterOdd = "©" + year + vbTab + FullMonth + " " + year


HeaderText = Array(HeaderOdd, HeaderFirst, HeaderEven)
FooterText = Array(FooterOdd, FooterFirst, FooterEven)
Set ThisDoc = ActiveDocument

For Each objSection In ActiveDocument.Sections
    For Each oHF In objSection.Headers
        oHF.Range.Delete
    Next
    For Each oHF In objSection.Footers
        oHF.Range.Delete
    Next
Next


With ThisDoc.Sections(1)
    For var = 1 To 3
            .Headers(var).Range.Text = HeaderText(var - 1)
            .Footers(var).Range.Text = FooterText(var - 1)
            With .Footers(var).Range
                If var = 1 Or var = 2 Then
                .InlineShapes.AddPicture "K:\DATA\IMAGES\filogo-nodate.emf", False, True
                End If
            End With
    Next
End With


ActiveWindow.View.ShowHiddenText = False
End Sub

1. When the headers and footers get put in with the current code, the same page number gets added to each page (i.e, every page says "Page 1").

2. I am using the vbTabs to space out the information on the left and right-hand sides of the headers/footer, but it seems that because of the two columns in the document, the right-hand headers and footers aren't completely flushed against the right side of the document.

3. When these new headers and footers get put in, they don't have the formatting that the old headers and footers had. This is an imperative part of the process and I honestly am not sure how to get them to be formatted the way they're supposed to be.

Thanks again for any help.

 

[fumei]

3. Are you using Styles? If you are, then simply make the range of the header (or footer) the appropriate style.

2. This should be done in the blank headers of the template. If it is, then the text inserted into them will be correctly margined.

1. This is because you are using Selection.Information(wdActiveEndPageNumber), and the Selection point is not changed (moved). Use the range of the header/footer object.

Put all together (assuming you create the myHeader style, and the myFooter styles), it could go like this:

Option Explicit

Sub HeadersAndFooters(currentFields, year, Month As String)
Dim ThisDoc As Document
Dim oHF As HeaderFooter
Dim FullMonth As String
Dim r As Range
Dim rPageNum As Long
Dim objSection As Section

FullMonth = MonthName(currentFields!PUB_MONTH_INT)

Set ThisDoc = ActiveDocument

For Each objSection In ThisDoc.Sections
   For Each oHF In objSection.Headers
      [b]Set r = oHF.Range[/b]
      rPageNum = CStr([b]r.Information[/b](wdActiveEndPageNumber))
      r.Delete
      [b]Select Case oHF.Index[/b]
      Case 1  [COLOR=red]' Primary or Odd pages[/color red]
         r.Text = currentFields!BOOK_NAME & vbTab & _
            vbTab & _
            "Page " & rPageNum & _
            vbCrLf & vbTab & vbTab & _
            currentFields!REPORT_TITLE
      Case 2  [COLOR=red]' DifferentFirstPage[/color red]
         r.Text = currentFields!BOOK_NAME
      Case 3  [COLOR=red]' DifferentEvenPage[/color red]
         r.Text = "Page " + rPageNum _
            & vbTab & vbTab & _
            currentFields!BOOK_NAME & _
            vbCrLf & currentFields!REPORT_TITLE
      End Select
      [COLOR=red]'  make each header range myHeader style[/color red]
      [b]r.Style = "myHeader"[/b]
   Next
   For Each oHF In objSection.Footers
      [b]Set r = oHF.Range[/b]
      rPageNum = CStr([b]r.Information[/b](wdActiveEndPageNumber))
      r.Delete
      [b]Select Case oHF.Index[/b]
      Case 1  [COLOR=red]' Primary or Odd Pages[/color red]
         With r
            .Text = "©" & year & vbTab & _
               FullMonth & " " & year
            .Collapse 0  'collapse to end
            .InlineShapes.AddPicture _
            "K:\DATA\IMAGES\filogo-nodate.emf", _
               False, True
         End With
      Case 2  [COLOR=red]' DifferentFirstPage[/color red]
         With r
            .Text = "©" & year & vbTab & FullMonth & _
               " " & year
            .Collapse 0   ' collapase to end
            .InlineShapes.AddPicture _
               "K:\DATA\IMAGES\filogo-nodate.emf", _
                  False, True
         End With
      Case 3  [COLOR=red]' DifferentEvenPage[/color red]
         r.Text = FullMonth + " " + year
      End Select
      [COLOR=red]'  make each footer myFooter style[/color red]
      [b]r.Style = "myFooter"[/b]
   Next
Next
End Sub

This:

1. creates and uses a Range object for each header/footer object

2. gets its page number and puts it in the rPageNum variable

3. deletes the range contents

4. using a Select Case of the .Index of the header (or footer) - it will be 1 (primary/Odd), 2 (FirstPage), or 3 (EvenPage) - insert the appropriate text, including the page number variable rPageNum.

In the case of footers, insert the string, collapse the range, and then add the picture.

This way you avoid using Selection, you do not need the arrays, and you can do everything for each Section in one operation, rather than the two separate ones you have.

Operation 1:

For Each objSection In ActiveDocument.Sections
    For Each oHF In objSection.Headers

actions through all the Sections.

Operation 2:

With ThisDoc.Sections(1)
    For var = 1 To 3

actions through all the Sections a second time.


Gerry

 

[CPForecast]

Gerry,

Thank you for the help thus far. When I ran the macro on the sample file that I attached, problems 1-3 are still happening.

I'm not even worrying about the formatting (problem 3) yet. I figure I'll take it one step at a time. I attached the file after I ran this macro. If you compare it to the original file I attached, you can see that the problems are still happening somehow. I'm not sure why this is the case. Is there anything else that could be causing these problems? Thanks again.

-Chris

 

[CPForecast]

Sorry, here's the correct changed file.

 

[fumei]

Sorry, but I can not access your file. Our firewall blocks it, and I no longer have internet access at home.

Let me play around with this a bit more.

Gerry

 

[CPForecast]

Problem number 2 (regarding the text not being flushed against the right side) was based on some tab stops in the document so I have solved that problem. I just need to figure out the page number and multiple style/formatting problems. If it would be easier, I can email you the changed file. Thanks again for the insight thus far.

 

[fumei]

You can send a sample file to:

gerry dot knight at hrsdc-rhdsc dot gc dot ca

Please put a reference to Tek-Tips in the Subject line.

I will see what I can see.

Gerry

 

[CPForecast]

Manually inserting the page number from the Headers and Footers toolbar seems to add the correct page number. I would much rather have the page number be a field so that it will update properly if new pages are added to the document. Does anyone know a way to incorporate that into the above solution?

 

[fumei]

You could try:

Option Explicit

Sub yaddaHead()
Dim r As Range
Dim oSection As Section
Dim oHF As HeaderFooter
Dim strStartText As String
Dim SectionNum As Long
Dim var
Dim Test1()
Dim OtherText()

strStartText = "Section "

OtherText = Array(" Primary (Odd) page header text", _
   " FirstPage page header text", _
   " EvenPage page header text")
   
For Each oSection In ActiveDocument.Sections
   SectionNum = oSection.Index
   For var = 1 To 3
      oSection.Headers(var).LinkToPrevious = False
      Set r = oSection.Headers(var).Range
      r.Delete
      With r
         .Text = strStartText & SectionNum & " Page "
         .Collapse 0
         .Fields.Add Range:=r, _
            Type:=wdFieldEmpty, _
            Text:="PAGE  ", _
            PreserveFormatting:=True
      End With
      Set r = oSection.Headers(var).Range
      r.InsertAfter Text:=OtherText(var - 1)
   Next
Next
End Sub

Note that this sets the header text for the appropriate header regardless of whether it is used or not. In other words, DifferentFirstPage and DifferentOddEven header text is set correctly, even if you do not use them.

Result?

Say three (3) Sections, and each Section has three pages. So a total of 9 pages.

IF DifferentFirstPage and DifferentOddEven are NOT set - only Primary is being used:

Section 1 Page 1 Primary (Odd) page header text
Section 1 Page 2 Primary (Odd) page header text
Section 1 Page 3 Primary (Odd) page header text

Section 2 Page 4 Primary (Odd) page header text
Section 2 Page 5 Primary (Odd) page header text
Section 2 Page 6 Primary (Odd) page header text

Section 3 Page 7 Primary (Odd) page header text
Section 3 Page 8 Primary (Odd) page header text
Section 3 Page 9 Primary (Odd) page header text

IF DifferentFirstPage and DifferentOddEven ARE set:

Section 1 Page 1 FirstPage page header text
Section 1 Page 2 EvenPage page header text
Section 1 Page 3 Primary (Odd) page header text

Section 2 Page 4 FirstPage page header text
Section 2 Page 5 Primary (Odd) page header text
Section 2 Page 6 EvenPage page header text

Section 3 Page 7 FirstPage page header text
Section 3 Page 8 EvenPage page header text
Section 3 Page 9 Primary (Odd) page header text

The beauty of the code is that if you do NOT have any of the different pages currently set, if you ever do...then they are already there.


Gerry

 

[CPForecast]

This method seem to do the trick. Thanks very much for your patience and help. I've been thrown into working on a pretty complex system and I'm sure I'll have other questions as time goes on. It's much appreciated to get help from the experts. Thanks again!

 

[fumei]

You are welcome. The thing with Word headers and footers is that once you grasp what they are as objects (child objects of Sections), it makes it MUCH easier to deal with them.

Gerry