Results 1 to 6 of 6
  1. #1
    2 Star Lounger
    Join Date
    Jul 2001
    Location
    Wisconsin, USA
    Posts
    193
    Thanks
    0
    Thanked 1 Time in 1 Post

    Macro to Loop Through H/F (2000 and up)

    I
    Attached Files Attached Files

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Macro to Loop Through H/F (2000 and up)

    Try this for the first one:

    Sub AdminRemoveDraft()
    Dim sec As Section
    Dim hdr As HeaderFooter
    For Each sec In ActiveDocument.Sections
    For Each hdr In sec.Headers
    If hdr.Exists Then
    hdr.Range.Delete
    End If
    Next hdr
    Next sec
    End Sub

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Macro to Loop Through H/F (2000 and up)

    It's not very clear what the second macro tries to do in the footer, since it relies on moving the selection, and it doesn't correspond to your description.

  4. #4
    2 Star Lounger
    Join Date
    Jul 2001
    Location
    Wisconsin, USA
    Posts
    193
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Macro to Loop Through H/F (2000 and up)

    The 2nd macro searches the document for highlighted E/A and changes to either Engineer or Architect then goes into each footer and replaces the date field code with an underline.

    I'll attach the document that this would be used on. Sorry I wasn't more clear.

    Again, thanks
    Attached Files Attached Files

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Macro to Loop Through H/F (2000 and up)

    Try this:

    Sub EngSpecFoot()
    ' EngSpecFoot Macro
    ' Delete date code and replace with file number, change E/A to Engineer
    ' and delete highlighting from Engineer
    '
    Dim sec As Section
    Dim ftr As HeaderFooter
    Dim fld As Field
    Dim rng As Range

    With Selection.Find
    .ClearFormatting
    .Highlight = True
    .Replacement.ClearFormatting
    .Replacement.Highlight = False
    .Text = "E/A"
    .Replacement.Text = "Engineer"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
    End With

    For Each sec In ActiveDocument.Sections
    For Each ftr In sec.Footers
    If ftr.Exists Then
    For Each fld In ftr.Range.Fields
    If fld.Type = wdFieldSaveDate Then
    Set rng = fld.Result
    rng.Delete
    rng.Text = "____________"
    End If
    Next fld
    End If
    Next ftr
    Next sec
    End Sub

  6. #6
    2 Star Lounger
    Join Date
    Jul 2001
    Location
    Wisconsin, USA
    Posts
    193
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Macro to Loop Through H/F (2000 and up)

    Once again, you've come through for me. Both macros work perfectly. <img src=/S/bananas.gif border=0 alt=bananas width=33 height=35>

    <img src=/S/thankyou.gif border=0 alt=thankyou width=40 height=15>

Posting Permissions

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