Thread: [Solved] Copy RightFooter, Delete Entire Footer, and Paste to LeftFooter
View Single Post
 
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