#1
|
|||
|
|||
Multiple words replacement
Hello,
Firstly, I am completely new to the Word VBA. I was just wondering, if there is any way to use a macro on my usecase. Imagine, that you have document, in which you have to change about 50 words (rest of the text is still the same). For example you want to send PF cards to your costumers with heartwarming texts and in every card you want to change name of the customer, mention how long you cooperate and some other stuf. In the end you have excel sheet with 50 columns (for each costumer) and 10 rows (with specific attributes for every costumer). In word document i replaced theese 10 words (=attributes) by code names (example: Dear costumer_name, I would like to mention our cooperation_lenght years of cooperation....) and you macro bellow. Answer is how to replace value in Const Replace by value from specific cell in excel sheet. Code: Sub DoReplace() Const Find1 = " customer_name " Const Replace1 = " Mr. Anderson " Const Find2 = " cooperation_lenght " Const Replace2 = " 10 " Dim FilePick As FileDialog Dim FileSelected As FileDialogSelectedItems Dim WordFile As Variant ' FileName placeholder in selected files loop Dim FileJob As String ' Filename for processing Dim WorkDoc As Object Dim WholeDoc As Range Dim FooterDoc As Range ' On Error GoTo CreateReports_Error Set FilePick = Application.FileDialog(msoFileDialogFilePicker) With FilePick .Title = "Choose Report Template" .Filters.Clear .Filters.Add "Word Documents & Templates", "*.do*" .Filters.Add "Word 2003 Document", "*.doc" .Filters.Add "Word 2003 Template", "*.dot" .Filters.Add "Word 2007 Document", "*.docx" .Filters.Add "Word 2007 Template", "*.dotx" .Show End With Set FileSelected = FilePick.SelectedItems If FileSelected.Count <> 0 Then For Each WordFile In FileSelected FileJob = WordFile Set WorkDoc = Application.Documents.Open(FileJob, , , , , , , , , , , False) Set WholeDoc = WorkDoc.Content Set FooterDoc = WorkDoc.Sections(1).Footers(wdHeaderFooterPrimary) .Range With FooterDoc .Find.Execute Find1, True, True, , , , True, , , Replace1, wdReplaceAll .Find.Execute Find2, True, True, , , , True, , , Replace2, wdReplaceAll End With With WholeDoc.Find .Execute Find1, True, True, , , , True, , , Replace1, wdReplaceAll .Execute Find2, True, True, , , , True, , , Replace2, wdReplaceAll End With WorkDoc.Save WorkDoc.Close Next End If MsgBox "Completed" DoReplace_Exit: Set WholeDoc = Nothing Set FilePick = Nothing Set WorkDoc = Nothing Set FooterDoc = Nothing Exit Sub DoReplace_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DoReplace of VBA Document ReplaceMulti" Resume DoReplace_Exit End Sub |
#2
|
||||
|
||||
Except for your workbook layout (which should be transposed), your requirements can be met with a mailmerge. No code required.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you very much, dear Sir. I failed in googling
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find only the first Instance of Words -Then Do Replacement | dan88 | Word VBA | 6 | 05-15-2016 06:30 AM |
VBA: Replacement of words based on a list | roderh | Excel Programming | 2 | 09-06-2015 08:54 PM |
how to replace to words with multiple formats | cdk270 | Word | 1 | 07-16-2015 01:56 AM |
Automatic Words replacement | psychologist | Word VBA | 3 | 11-22-2014 11:40 AM |
Multiple words, one search | return2300 | Word VBA | 0 | 08-30-2013 12:26 PM |