#1
|
|||
|
|||
Replace or apply new header in multiple files
Our company has specification with our own headers and footers, however from time to time we are required to use a header and footer not of our own. It becomes tedious to open each file and delete the header and replace it with the new one. I can't simply do a find and replace because the format of the header is always completely different.
Any ideas on how to change headers in multiple files? I received code a while back from macropod which would find and replace text within headers with multiple files which works great. I was thinking it would be similar but not sure how to alter the code. Also how do I keep the original formatting such as text size and font from the source? I have set it up with the use of forms. The following code is what I received from macropod, but it has been altered for my application. Code:
Private Sub cbOptionOK_Click() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, wdDoc As Document Dim strFnd As String, strRep As String, wdStory(), i As Long 'Cue function to select folder where files are found strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) Select Case cboHFList.Value Case "Replace Header" '****************************************************** Case "Edit text within header" 'Input text strFnd = InputBox("Text to Replace", "Old String", "Water Feature Facility") If strFnd = "" Then Exit Sub strRep = InputBox("Replacement Text", "New String") If strRep = "" Then Exit Sub wdStory = Array(wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc On Error Resume Next For i = LBound(wdStory) To UBound(wdStory) 'MsgBox wdStory(i) With .StoryRanges(wdStory(i)).Find .ClearFormatting .Replacement.ClearFormatting .Text = strFnd .Replacement.Text = strRep .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = True .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With Next On Error GoTo 0 .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDoc = Nothing Application.ScreenUpdating = True Private Sub UserForm_Initialize() cboHFList.AddItem "Replace header" cboHFList.AddItem "Edit text within header" End Sub 'Function to select folder where files are found Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function |
Tags |
macropod |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find & Replace in Header/Footer in 1000 files | amodiammmuneerk@glenmarkp | Word | 12 | 03-05-2018 03:31 AM |
Find & Replace in Header/Footer | PReinie | Word | 6 | 01-22-2014 06:45 PM |
How to apply a list style to multiple Word documents? | MrSnrub | Word | 4 | 06-19-2013 07:32 AM |
Apply template to multiple documents | Oliver Beirne | Word VBA | 2 | 04-24-2012 04:49 AM |
convert multiple csv files to multiple excel files | mit | Excel | 1 | 06-14-2011 10:15 AM |