![]() |
#1
|
|||
|
|||
![]()
Dear All,
I am struggling to finalise a word macro that will: - open multiple files (check) - delete all existing headers and footers (check) - insert new graphics into headers and footers (check) - Adjust size of graphics - MISSING - Adjust formatting such as indentation, alignment etc of headers and footers - MISSING I will also attach a example file of how the final result should look like and one for which these changes will have to be made. And the images. Would be absolutely great if you guys could help on this. I am really struggling Here is what I have so far: Private Sub CommandButton3_Click() Dim MyDialog As FileDialog, GetStr(1 To 100) As String Dim oSec As Section Dim oHead As HeaderFooter Dim oFoot As HeaderFooter On Error Resume Next Set MyDialog = Application.FileDialog(msoFileDialogFilePicker) With MyDialog .Filters.Clear .Filters.Add "All WORD File ", "*.docx", 1 .AllowMultiSelect = True I = 1 If .Show = -1 Then For Each stiSelectedItem In .SelectedItems GetStr(I) = stiSelectedItem I = I + 1 Next I = I - 1 End If Application.ScreenUpdating = False For j = 1 To I Step 1 Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True) Windows(GetStr(j)).Activate For Each oSec In ActiveDocument.Sections For Each oHead In oSec.Headers If oHead.Exists Then oHead.Range.Delete Next oHead For Each oFoot In oSec.Footers If oFoot.Exists Then oFoot.Range.Delete Next oFoot ActiveDocument.Sections.Item(1).Headers(wdHeaderFo oterPrimary).Range.InlineShapes.AddPicture FileName:="https://intranet.ggh.uk/elements/20161003_Ensure_insurance_certificate_header.png" ActiveDocument.Sections.Item(1).Footers(wdHeaderFo oterPrimary).Range.InlineShapes.AddPicture FileName:="https://intranet.ggh.uk/elements/20161003_Ensure_insurance_certificate_footer.png" ActiveDocument.Save ActiveDocument.Close Next oSec Next Application.ScreenUpdating = True End With MsgBox "All selected files were updated, saved and closed. Please double check every document individually!", vbInformation End Sub |
Tags |
letterhead |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
scot | Word | 3 | 05-22-2015 09:45 AM |
Macro for find/replace (including headers and footers) for multiple documents | jpb103 | Word VBA | 2 | 05-16-2014 04:59 AM |
![]() |
Kingsmoss | Word | 3 | 04-28-2014 02:43 PM |
![]() |
teza2k06 | Word | 1 | 05-14-2013 11:07 AM |
Headers and Footers | OverAchiever13 | Word | 1 | 05-27-2010 01:30 PM |