Copy RightFooter, Delete Entire Footer, and Paste to LeftFooter

reynolds0431 · #1 08-25-2015, 07:04 PM

Hello. I'm really stuck on coming up with a viable line of code to do the following:

My Word doc has a footer with data in the left, center, and right areas. The right footer area will always have two lines. The first, a five digit number and the second, a date. The document already copies a letterhead, via a end-user form, from a network intranet where multiple different office letterheads are stored. When the end-user uses the form to select their office, the left and right footers need to be deleted, leaving only the two lines of data in the right footer. Also, the right footer would need to be left-aligned.

Is there a way to do this? I was thinking to copy the two right footer lines, deleting the entire footer contents, and then pasting the clipboard.

Thank you in advance for any expertise you could share.

gmayor · #2 08-25-2015, 09:03 PM

Post a copy of a document containing the footer so we can see how it is formatted. It sounds like a table from your description, but it could also be two paragraphs. If you post a screenshot rather than attach a document, make sure that the formatting characters are on - ¶ button on the Home tab!

reynolds0431 · #3 08-25-2015, 09:20 PM

Thanks for the response. The footers are in paragraph. But, I feel a table would be more appropriate. Doesn't seem like an issue to add a table to all of our letters.

Would a table be easier to handle what needs to be done in vba?

gmayor · #4 08-25-2015, 09:50 PM

OK so far. What exactly do you wish to retain? If you remove the left and right sections, you are left with the page number, which is only one line of text with an empty paragraph above?

It doesn't matter whether you use a table or paragraphs as long as it is know which before you start.

reynolds0431 · #5 08-25-2015, 09:56 PM

Sorry, there was an error in the initial post. The left (FileName) and center (Page # of #) sections would be deleted, leaving the five-digit ID and publish date, which are both situated on the right. Ideally, the five-digit ID and date on the right would be left-aligned after the other information is removed.

gmayor · #6 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

reynolds0431 · #7 08-26-2015, 07:47 AM

Unfortunately, that doesn't seem to work. Maybe the issue being that the filename wouldn't always be the same? When I applied your code, in some cases the entire ID number was deleted and some of the date. Here is my whole Private Sub. I tried placing a call before and after the footer shapes delete lines.

Code:

Private Sub cmdLetterhead_Click()
'adds letterhead to document from intranet, based on office selected via frmOffice
    Dim tmpDir As String, tmpFile As String, tmpFileRev As String
    Dim Rng As Range, Rng2 As Range
    Dim FileLocation
    Dim i As Integer
 
    iOffice = -1 'initializes variable
    frmOffice.Show  'user form for users to select office
 
    If bOffice Then Exit Sub
 
    If Me.ProtectionType = wdAllowOnlyFormFields Then _
        Me.Unprotect
 
    If iOffice < 0 Then  'no office selected
        Me.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Delete
        Selection.HomeKey wdStory
        Me.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
        Me.FormFields("Text2").Select
        Exit Sub
    End If
 
        tmpDir = "http://adminastar.com/intranet/marketing/"
 
'populates array for use with frmOffice combobox result
'array must be in same order as City array located in frmOffice
    FileLocation = Array( _
        "letterhead/100_roscommon_drive_CT.docx", "letterhead/1301_pennsylvania_Ave_DC.docx", "letterhead/1351_william_howard_taft_road_OH.docx", "letterhead/13550_triton_office_park_blvd_KY.docx", "letterhead/2_gannett_drive_ME.docx", "letterhead/200_isaac_shelby_drive_KY.docx", _
        "letterhead/20711_watertown_road_WI.docx", "letterhead/2245_rolling_run_drive_MD.docx", "letterhead/2400_thea_drive_PA.docx", "letterhead/26555_evergreen_road_MI.docx", "letterhead/3000_goffs_falls_road_NH.docx", "letterhead/4203_williamson_place_IL.docx", _
        "letterhead/5000_brittonfield_parkway_NY.docx", "letterhead/6775_west_washington_street_WI.docx", "letterhead/7133_rutherford_road_MD.docx", "letterhead/8002_discovery_drive.docx", "letterhead/8002_discovery_drive_VA.docx", "letterhead/8115_knue_road_IN.docx", _
        "letterhead/A_CMS_Contracted_Agent_8115_knue_road_IN.docx", "letterhead/po_box_4776_NY.docx", "letterhead/po_box_4811_NY.docx", "letterhead/po_box_4900_NY.docx", "letterhead/po_box_6036_NY.docx", "letterhead/po_box_6130_congressional.docx", "letterhead/po_box_6131_foia.docx", "letterhead/po_box_6130_IN_congressional.docx", _
        "letterhead/po_box_6131_IN.docx", "letterhead/po_box_7050_IN.docx", "letterhead/po_box_6160_IN.docx", "letterhead/po_box_6189_IN.docx", "letterhead/po_box_6230_IN.docx", _
        "letterhead/po_box_6474_IN.docx", "letterhead/po_box_6475_IN.docx", "letterhead/po_box_7051_IN.docx", "letterhead/po_box_7053_IN.docx", "letterhead/po_box_7064_IN.docx", "letterhead/po_box_7073_IN.docx", "letterhead/po_box_7078_IN.docx", "letterhead/po_box_7091_IN.docx", "letterhead/po_box_7108_IN.docx", _
        "letterhead/po_box_7111_IN.docx", "letterhead/po_box_7141.docx", "letterhead/po_box_7141_IN_1-800.docx", "letterhead/po_box_7141_IN_PROV.docx", "letterhead/po_box_7141_IN_PROV_DUP.docx", "letterhead/po_box_7149.docx", "letterhead/po_box_7155_IN.docx", "letterhead/po_box_7191_IN.docx", "letterhead/po_box_7191_IN_CC_0990.docx")
    Application.ScreenUpdating = False
'deletes current letterhead and MARP header/footer if they exist
    With Me.Sections(1)
        With .Headers(wdHeaderFooterFirstPage)
            .Range.Delete
            On Error Resume Next
            For i = 1 To .Shapes.Count
                .Shapes(i).Delete
            Next i
            On Error GoTo 0
        End With
        With .Headers(wdHeaderFooterPrimary)
            .Range.Delete
            On Error Resume Next
            For i = 1 To .Shapes.Count
            .Shapes(i).Delete
            Next i
            On Error GoTo 0
        End With
        .Headers(wdHeaderFooterPrimary).Range.Delete
 
        On Error Resume Next
        With .Footers(wdHeaderFooterFirstPage)
            For i = 1 To .Shapes.Count
                .Shapes(i).Delete
            Next i
        End With
 
        .Footers(wdHeaderFooterPrimary).Range.Delete
 
        On Error GoTo 0
 
    Documents.Open tmpDir & FileLocation(iOffice)
'copies letterhead image from template to this document
    Set Rng = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range
    Rng.Copy
    With Me.Sections(1).Headers(wdHeaderFooterFirstPage).Range
        .Paste
        .Paragraphs(2).Alignment = wdAlignParagraphLeft
    End With
 
     Set Rng = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range
        Rng.Copy
        Me.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Paste
 
    ActiveDocument.Close False
 
    Me.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
    Me.FormFields("Text2").Select
 
    Application.ScreenUpdating = True
 End With
 
End Sub

macropod · #8 08-26-2015, 03:07 PM

Cross-posted at: http://www.mrexcel.com/forum/general...eftfooter.html

For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

gmayor · #9 08-26-2015, 09:01 PM

The macro I posted works for the specific example you provided, which is why I asked for it. It cannot possibly work for different formats that I have not seen. You should however be able to adopt the methods used to produce code that would work for each type of footer layout, adjusting the ranges as appropriate.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to select and copy to clipboard an entire document except for a paragraph and keep formatting	TD_123	Word VBA	7	06-16-2015 03:30 PM
New here: How do i delete an entire notebook?	DixieSister	OneNote	2	02-20-2015 12:45 PM
Is there any way to copy an entire page?	Jennifer Murphy	Visio	6	05-09-2013 06:20 AM
Paste Special: Copy and Paste Formatting Only?	tinfanide	Word	6	03-06-2013 12:21 AM
Copy/Paste/Delete Table & Section etc.	flds	Word VBA	40	07-16-2011 07:34 AM