#16
|
|||
|
|||
I originally received the error with the code in post #11 so I was trying different options and forgot to delete that code before posting. I looked at the references as per post #17 and the only reference is "Reference to Normal"
If all else fails I can always go back to the original code that worked without formatting. It will still save an enormous amount of time. Thanks for your help on this Paul. |
#17
|
||||
|
||||
Perhaps then you should post the code you're actually using that's failing. The code you posted certainly won't work.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#18
|
|||
|
|||
Note that I haven't updated the footer code to match the header. The same error shows up for each case I select in the userform. If I isolate the footer code it works but if I isolate the header code it gives me the same error. Here is the whole thing:
Code:
Option Explicit 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 Dim wdDocTgt As Document, wdDocSrc As Document Dim Sctn As Section, HdFt As HeaderFooter 'Cue function to select folder where specification files are found strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) Unload Me Select Case cboHFList.Value Case "Replace header" With Application.Dialogs(wdDialogFileOpen) 'Open header source file If .Show = -1 Then Set wdDocSrc = ActiveDocument Else MsgBox "No Source document chosen. Exiting", vbExclamation Exit Sub End If End With strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, _ AddToRecentFiles:=False, Visible:=False) With wdDocTgt For Each Sctn In .Sections For Each HdFt In Sctn.Headers With HdFt If .Exists Then If .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.Copy wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.PasteAndFormat wdFormatOriginalFormatting End If End If End With Next Next .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDocSrc = Nothing: Set wdDocTgt = Nothing Application.ScreenUpdating = True '********************************************************************************************** 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 '****************************************************************************************** Case "Replace footer" With Application.Dialogs(wdDialogFileOpen) If .Show = -1 Then Set wdDocSrc = ActiveDocument Else MsgBox "No Source document chosen. Exiting", vbExclamation Exit Sub End If End With strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, _ AddToRecentFiles:=False, Visible:=False) With wdDocTgt For Each Sctn In .Sections For Each HdFt In Sctn.Footers With HdFt If .LinkToPrevious = False Then .Range.FormattedText = _ wdDocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.FormattedText End If End With Next Next .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDocSrc = Nothing: Set wdDocTgt = Nothing Application.ScreenUpdating = True '*************************************************************************************** Case "Edit text within footer" strFnd = InputBox("Text to Replace", "Old String") If strFnd = "" Then Exit Sub strRep = InputBox("Replacement Text", "New String") If strRep = "" Then Exit Sub wdStory = Array(wdPrimaryFooterStory, wdFirstPageFooterStory, wdEvenPagesFooterStory) 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 End Select End Sub Private Sub UserForm_Initialize() cboHFList.AddItem "Replace header" cboHFList.AddItem "Edit text within header" cboHFList.AddItem "Replace footer" cboHFList.AddItem "Edit text within footer" 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 |
#19
|
||||
|
||||
You have NOT made the change as advised in post #11! You should not still have:
.Range.FormattedText = _
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#20
|
|||
|
|||
I can't believe I overlooked that! And to think we could have been done at post #11. It works perfectly. Thanks Paul for your patience and help. This macro does everything I need it too, thanks again.
|
#21
|
|||
|
|||
Macropod, I need your help!
Long time since I've been on here. Any idea why this same Macro won't work in Word 2010 and 2013? I've tried researching the differences between the code for 2007 vs later versions but can't find anything. Thanks |
#22
|
||||
|
||||
There is no reason for the code to not work in Word 2010 or 2013. Indeed, at my end it was developed & tested on Word 2010.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#23
|
|||
|
|||
Everything but the replace header works. It copies the first line of the document instead, as seen in the pic.
|
#24
|
||||
|
||||
That looks to me rather like the header you're copying has a STYLEREF field that's picking up the Style used by the heading that's being replicated. Try pressing Alt-F9 in the affected document - you may then seen a field coded like { STYELREF MyStyle } in the header.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#25
|
|||
|
|||
Paul,
It's been a busy few months. I did as you told me, pressed Alt-F9 and no STYLEREF's are present. Just to make sure I created one in the header and keyed Alt-F9 and the STYLEREF showed up. So we can eliminate that one. I am using Windows 10 but I don't think that could be the culprit either. |
#26
|
||||
|
||||
Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#27
|
|||
|
|||
Paul,
I experimented a little with these two files I have attached. Two scenarios with two different results:
|
#28
|
||||
|
||||
Your documents have different page layouts - Test1 has a std page layout but Test2 has a 'different first page' setup'. The macro is not coded for the latter, as it references only:
wdHeaderFooterPrimary
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#29
|
|||
|
|||
Carchee,
Is there any way you can post your code file? I am looking to do the exact same thing as you but could not get it working with the codes that were posted. Thanks in advance! |
#30
|
|||
|
|||
Re: macropod
Hello macropod,
Your script here works nearly perfectly for something I am trying to achieve, and I was hoping you could give me a tip on an issue I am facing. I have a source document with headers and footers that I want to push to a whole folder of word documents. The issue is that in some of the word documents that are receiving the new headers/footers have a table in the footer. For example some have a 1 row, 2 column table in the footer to show the page title and project number respectively. When I run the script you wrote (which works exactly how it is written) it doesnt remove the table and replace it with the source footer. Instead it just removes all the text and replaces it with the source text. This causes extra spacing and formatting issues since is extra spacing with the tables. If you have any tips I would greatly appreciate it. Thank you! |
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 |