#1
|
|||
|
|||
Replace specific word inside a table in the Header with Merge field
Hi,
I'm trying to replace hardcoded addresses in a table inside the header with mailmerge fields e.g. 1 Spring Avenue Springarea Springtown Springfield TT4 77S With {MERGEFIELD Address_line1} {MERGEFIELD Address_line2} {MERGEFIELD Address_line3} {MERGEFIELD Address_line4} {MERGEFIELD Address_PostCode} The same address appears elsewhere like in main area or footer but only the address in the header should be replaced I have tried Sub replace() Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:="Springtown") oRng.Fields.Add oRng, wdFieldMergeField, "Address_line1", False oRng.Collapse wdCollapseEnd Loop End With End Sub Sub replace2() Dim oRng As Range Dim hf As Word.HeaderFooter Dim tableCount As Integer Dim t As Integer Dim c As Cell Set oRng = ActiveDocument.Range For Each hf In oRng.Sections(1).Headers() tableCount = hf.Range.Tables.Count For t = 1 To tableCount For Each c In hf.Range.Tables(t).Range.Cells Debug.Print c.Range.Text With c.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "Colchester" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With If .Find.Found = True Then .Fields.Add .Range, wdFieldEmpty, "MERGEFIELD Address_line1", False End If Next c Next t Next hf End Sub Sub replace3() Dim oRng As Range Dim hf As Word.HeaderFooter Dim tableCount As Integer Dim t As Integer Dim c As Cell For Each hf In ActiveDocument.Sections(1).Headers With hf.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "Springtown" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With If .Find.Found = True Then .Fields.Add .Range, wdFieldEmpty, "MERGEFIELD Address_line1", False End If End With Next End Sub But i am not having much luck - any ideas Thanks |
#2
|
|||
|
|||
Code:
Sub replace3() Dim oRng As Range Dim hf As Word.HeaderFooter For Each hf In ActiveDocument.Sections(1).Headers Set oRng = hf.Range With oRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "Springtown" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True While .Execute hf.Range.Fields.Add oRng, wdFieldEmpty, "MERGEFIELD Address_line1", False oRng.Collapse wdCollapseEnd Wend End With Next End Sub |
#3
|
||||
|
||||
Perhaps as a single macro:
Code:
Sub Demo() Application.ScreenUpdating = False Dim Rng As Range With ActiveDocument.Sections.First.Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 3) Set Rng = .Range Rng.Text = vbNullString Rng.End = Rng.End - 1 .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_PostCode", False Rng.Characters.Last.InsertBefore " " .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line4", False Rng.Characters.Last.InsertBefore Chr(11) .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line3", False Rng.Characters.Last.InsertBefore Chr(11) .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line2", False Rng.Characters.Last.InsertBefore Chr(11) .Range.Fields.Add Rng, wdFieldEmpty, "MERGEFIELD Address_line1", False End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
||||
|
||||
Cross-posted at: https://social.msdn.microsoft.com/Fo...?forum=worddev
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
mergefields |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Update & Unlink Specific Merge Field in Word Doc from Mail Merge - Excel VBA | RMerckling | Mail Merge | 16 | 05-17-2018 05:19 PM |
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color | jc491 | Word VBA | 8 | 09-30-2015 06:10 AM |
Adding field in word in header in a bookmark in table with Excel vba Late Binding | Hdr | Excel Programming | 6 | 02-11-2013 02:58 AM |
Excel vba adding field in word table/shape in a header | Hdr | Excel | 1 | 02-04-2013 04:40 PM |
Merge field in header disappearing | Medievalguy88 | Word | 2 | 01-06-2011 08:19 AM |