Results 1 to 8 of 8
  1. #1
    New Lounger
    Join Date
    Jul 2003
    Posts
    19
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Footers (VBA) and Sections (XP)

    <P ID="edit" class=small>(Edited by jscher2000 on 31-Jul-03 11:48. Added [ pre ] and [ /pre ] tags arround the code to preserve the indenting.)</P>I'm using the below to add footers to word documents. I've run into an issue where it won't update all sections of the documents footers. Attached is a sample of the document where this does not work. If I run the code it will only update the first page(section). Then I have to select the second section and re-run.

    I want to run once and have it update the document.

    ***CODE*****************************
    <pre>Application.ScreenUpdating = False
    varName = "Name"
    varPhone = "Phone"

    varcount = ActiveDocument.Sections.Count

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

    Selection.TypeText Text:=varName & Chr(10) & varPhone & Chr(10) & Date & Chr(10)
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "FILENAME", PreserveFormatting:=True
    Selection.TypeText Text:=vbTab & vbTab
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
    Selection.TypeParagraph
    Selection.WholeStory
    With Selection.Font
    .Name = "Times New Roman"
    .Size = 8
    .Bold = False
    .Italic = False
    .Underline = wdUnderlineNone
    .UnderlineColor = wdColorAutomatic
    .StrikeThrough = False
    .DoubleStrikeThrough = False
    .Outline = False
    .Emboss = False
    .Shadow = False
    .Hidden = False
    .SmallCaps = False
    .AllCaps = False
    .Color = wdColorAutomatic
    .Engrave = False
    .Superscript = False
    .Subscript = False
    .Spacing = 0
    .Scaling = 100
    .Position = 0
    .Kerning = 0
    .Animation = wdAnimationNone
    End With

    i = 2
    If varcount > 1 Then
    Do Until i > varcount
    With ActiveDocument.Sections(i).Footers(wdHeaderFooterP rimary)
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.TypeText Text:=varName & Chr(10) & varPhone & Chr(10) & Date & Chr(10)
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "FILENAME", PreserveFormatting:=True
    Selection.TypeText Text:=vbTab & vbTab
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
    Selection.TypeParagraph
    Selection.WholeStory
    With Selection.Font
    .Name = "Times New Roman"
    .Size = 8
    .Bold = False
    .Italic = False
    .Underline = wdUnderlineNone
    .UnderlineColor = wdColorAutomatic
    .StrikeThrough = False
    .DoubleStrikeThrough = False
    .Outline = False
    .Emboss = False
    .Shadow = False
    .Hidden = False
    .SmallCaps = False
    .AllCaps = False
    .Color = wdColorAutomatic
    .Engrave = False
    .Superscript = False
    .Subscript = False
    .Spacing = 0
    .Scaling = 100
    .Position = 0
    .Kerning = 0
    .Animation = wdAnimationNone
    End With
    With Selection.HeaderFooter.PageNumbers
    .NumberStyle = wdPageNumberStyleArabic
    .HeadingLevelForChapter = 0
    .IncludeChapterNumber = False
    .ChapterPageSeparator = wdSeparatorHyphen
    .RestartNumberingAtSection = False
    .StartingNumber = 0
    End With
    End With

    i = i + 1
    Loop

    End If

    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    'Turn on Screen Updating
    Application.ScreenUpdating = True</pre>

    ***CODE*****************************

    Thank you very much!!
    Attached Files Attached Files

  2. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Footers (VBA) and Sections (XP)

    Yes, this is a known problem. You do have to code around it by visiting all the sections. Something along the lines of:

    <pre>Dim sect As Section, ftr As HeaderFooter
    For Each sect In ActiveDocument.Sections
    For Each ftr In sect.Footers
    If ftr.Exists Then
    'do stuff
    End If
    Next ftr
    Next sect</pre>

    Check out this recent thread regarding the meaning and usefulness of .Exists versus other methods of learning about the headers and footers in each section.

    I suspect there are more efficient ways to handle the do stuff also, but I've got to run to a meeting, so... Hope this helps.

  3. #3
    New Lounger
    Join Date
    Jul 2003
    Posts
    19
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Footers (VBA) and Sections (XP)

    I tried using this framework but same issue, only works for one section at a time. In fact, I'm getting a new issue that it is doubling the footer data!

    Any suggestions??

  4. #4
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Footers (VBA) and Sections (XP)

    I only gave half the answer: if you are using a loop of ranges, it's best not to mix it with the Selection. Here's a working example with comments addressing the problem of doubling the information, and also suggesting a cleaner way to handle the formatting:
    <pre>Sub FooterUpdate()
    Dim varName As String, varPhone As String, rngTemp As Range
    varName = "Name"
    varPhone = "Phone"

    'Modification of document body omitted

    Dim sect As Section, ftr As HeaderFooter
    For Each sect In ActiveDocument.Sections
    'Update each existing footer in the section, if it's not just a carryover
    For Each ftr In sect.Footers
    If (ftr.Exists = True) And (ftr.LinkToPrevious = False) Then
    'Create temporary range for the field insert
    Set rngTemp = ftr.Range.Duplicate
    rngTemp.Collapse wdCollapseStart
    'Insert new text at the beginning of the footer
    ftr.Range.Fields.Add Range:=rngTemp, Type:=wdFieldEmpty, _
    Text:="FILENAME", PreserveFormatting:=True
    rngTemp.InsertBefore varName & Chr(10) & varPhone & Chr(10) & _
    Date & Chr(10)
    'Reformat the entire footer; alternately could apply the Footer style
    With ftr.Range.Font
    .Name = "Times New Roman"
    .Size = 8
    .Bold = False
    .Italic = False
    .Underline = wdUnderlineNone
    .UnderlineColor = wdColorAutomatic
    .StrikeThrough = False
    .DoubleStrikeThrough = False
    .Outline = False
    .Emboss = False
    .Shadow = False
    .Hidden = False
    .SmallCaps = False
    .AllCaps = False
    .Color = wdColorAutomatic
    .Engrave = False
    .Superscript = False
    .Subscript = False
    .Spacing = 0
    .Scaling = 100
    .Position = 0
    .Kerning = 0
    .Animation = wdAnimationNone
    End With
    'Set page number settings for the footer
    With ftr.PageNumbers
    .NumberStyle = wdPageNumberStyleArabic
    .HeadingLevelForChapter = 0
    .IncludeChapterNumber = False
    .ChapterPageSeparator = wdSeparatorHyphen
    .RestartNumberingAtSection = False
    .StartingNumber = 0
    End With
    'Destroy the temporary range
    Set rngTemp = Nothing
    End If
    Next ftr
    Next sect
    End Sub</pre>

    Hope this helps.

  5. #5
    New Lounger
    Join Date
    Jul 2003
    Posts
    19
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Footers (VBA) and Sections (XP)

    Jefferson-

    Thank you so very much!!! This is exactly what I was looking for. Thank you for your time!!

    I had one question: I had in a section to tab twice and place a page number. How do I incorporate this?

    Once again thank you very much.

  6. #6
    New Lounger
    Join Date
    Jul 2003
    Posts
    19
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Footers (VBA) and Sections (XP)

    Here is what I have come up with...

    <pre> Dim sect As Section, ftr As HeaderFooter
    For Each sect In ActiveDocument.Sections
    'Update each existing footer in the section, if it's not just a carryover
    For Each ftr In sect.Footers
    If (ftr.Exists = True) And (ftr.LinkToPrevious = False) Then
    'Create temporary range for the field insert
    Set rngTemp = ftr.Range.Duplicate
    rngTemp.Collapse wdCollapseStart
    'Insert new text starting at the beginning of the footer and move down as we
    'add new information

    'Insert Page Number and 2 Tab Breaks
    ftr.Range.Fields.Add Range:=rngTemp, Type:=wdFieldPage
    rngTemp.InsertAfter Chr(9) & Chr(9)

    'Insert File Name
    With rngTemp
    'Move in by two tab spaces and FileName
    .MoveEnd Unit:=wdCharacter, Count:=-2
    .Collapse Direction:=wdCollapseEnd
    ftr.Range.Fields.Add Range:=rngTemp, Type:=wdFieldEmpty, _
    Text:="FILENAME", PreserveFormatting:=True
    End With

    'Insert Name, Phone and Date
    rngTemp.InsertBefore varName & Chr(10) & varPhone & Chr(10) & _
    Date & Chr(10)

    '**** ALL OTHER CODE REMAINS THE SAME******
    </pre>



    Thanks!!

  7. #7
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Footers (VBA) and Sections (XP)

    I missed that completely, sorry. Immediately after the line that says:
    <pre> 'Insert new text at the beginning of the footer</pre>

    add this:
    <pre> ftr.Range.Fields.Add Range:=rngTemp, Type:=wdFieldPage
    rngTemp.InsertBefore vbTab & vbTab
    rngTemp.Collapse wdCollapseStart</pre>

    As you can see, I'm still working backwards to preserve whatever might have been in the footer originally..

  8. #8
    New Lounger
    Join Date
    Jul 2003
    Posts
    19
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Footers (VBA) and Sections (XP)

    Thank you very much for all your help with this!!! You rock!!

    Here is what I now have:

    <pre>Dim sect As Section, ftr As HeaderFooter
    For Each sect In ActiveDocument.Sections
    'Update each existing footer in the section, if it's not just a carryover
    For Each ftr In sect.Footers
    If (ftr.Exists = True) And (ftr.LinkToPrevious = False) Then
    'Create temporary range for the field insert
    Set rngTemp = ftr.Range.Duplicate
    rngTemp.Collapse wdCollapseStart
    'Insert new text starting at the beginning of the footer and move down as we
    'add new information

    'Insert Page Number and 2 Tab Breaks
    ftr.Range.Fields.Add Range:=rngTemp, Type:=wdFieldPage
    rngTemp.InsertBefore vbTab & vbTab
    rngTemp.Collapse wdCollapseStart

    'Insert File Name
    With rngTemp
    'Move in by two tab spaces and FileName
    .MoveEnd Unit:=wdCharacter, Count:=-2
    .Collapse Direction:=wdCollapseEnd
    ftr.Range.Fields.Add Range:=rngTemp, Type:=wdFieldEmpty, _
    Text:="FILENAME", PreserveFormatting:=True
    End With

    'Insert Name, Phone and Date
    rngTemp.InsertBefore varName & Chr(10) & varPhone & Chr(10) & _
    Date & Chr(10)

    'Rest is the Same
    </pre>


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •