Microsoft Office Forums - View Single Post - [Solved] Copy RightFooter, Delete Entire Footer, and Paste to LeftFooter

gmayor · 08-25-2015, 10:33 PM

If the date is today's date, the following will work for the example:

Code:

Sub ReformatFooter()
Dim oFooter As HeaderFooter
Dim oPara As Paragraph
Dim oRng As Range
    Set oFooter = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage)
    For Each oPara In oFooter.Range.Paragraphs
        Set oRng = oPara.Range
        If InStr(1, oRng.Text, Chr(9)) = 0 Then
            oPara.Range.Delete
        Else
            oRng.MoveEndUntil Chr(9), wdBackward
            oRng.Delete
        End If
    Next oPara
    oFooter.Range.InsertAfter vbCr & Format(Date, "d/m/yy")
lbl_Exit:
    Set oFooter = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

If the original date is important then it's a bit more fiddly e.g.

Code:

Sub ReformatFooter()
Dim oFooter As HeaderFooter
Dim oPara As Paragraph
Dim oRng As Range
    Set oFooter = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage)
    oFooter.Range.Paragraphs(1).Range.Delete

    Set oRng = oFooter.Range.Paragraphs.First.Range
    oRng.MoveEndUntil Chr(9), wdBackward
    oRng.Delete
    Set oRng = oFooter.Range.Paragraphs(2).Range
    With oRng
        .Collapse 1
        .MoveEndUntil "0123456789"
        .Delete
    End With
lbl_Exit:
    Set oFooter = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub