Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 08-25-2015, 07:04 PM
reynolds0431 reynolds0431 is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2015
Posts: 4
reynolds0431 is on a distinguished road
Default Copy RightFooter, Delete Entire Footer, and Paste to LeftFooter

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.
Reply With Quote
  #2  
Old 08-25-2015, 09:03 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 2,598
gmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the rough
Default

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!
__________________
Graham Mayor - MS MVP (Word)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 08-25-2015, 09:20 PM
reynolds0431 reynolds0431 is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2015
Posts: 4
reynolds0431 is on a distinguished road
Default

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?
Attached Files
File Type: docm Footer Example.docm (18.7 KB, 6 views)
Reply With Quote
  #4  
Old 08-25-2015, 09:50 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 2,598
gmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the rough
Default

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.
__________________
Graham Mayor - MS MVP (Word)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #5  
Old 08-25-2015, 09:56 PM
reynolds0431 reynolds0431 is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2015
Posts: 4
reynolds0431 is on a distinguished road
Default

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.
Reply With Quote
  #6  
Old 08-25-2015, 10:33 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 2,598
gmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the rough
Default

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
__________________
Graham Mayor - MS MVP (Word)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #7  
Old 08-26-2015, 07:47 AM
reynolds0431 reynolds0431 is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2015
Posts: 4
reynolds0431 is on a distinguished road
Default

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
Reply With Quote
  #8  
Old 08-26-2015, 03:07 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 18,616
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

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

For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #9  
Old 08-26-2015, 09:01 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 2,598
gmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the roughgmayor is a jewel in the rough
Default

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.
__________________
Graham Mayor - MS MVP (Word)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
Reply

Tags
copy rightfooter, footer, vba

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 04:24 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft