Dynamic Data from Excel to Word

[Guest]

I got a Word Document template with some keys phrases to be replaced by the
content (for example, document numbers, etc.) of specific cells located on a
Excel workbook. I want that my code search in the Word document for specifics
phrases and replace that with the text that my specific cells had. How can I
do that? Ideas will be appreciated.

 

[Dave D-C]

' This is a start (works with Office97) - mainly for my benefit.
' Hope this helps you. Thanks for the post.

Option Explicit

Sub sub1()
' This assumes that Word is running and z1.doc is open and active.
' Word could be "created" if not running.
' z1.doc could be opened if not open.
' z1.doc could be activated if not active.
Dim zObj As Object, sFind$, sReplace$
sFind = Cells(1, 1)
sReplace = Cells(1, 2)
On Error GoTo err1
Set zObj = GetObject(, "Word.Application")
On Error GoTo err2
If Not zObj.Windows("z1.doc").Active Then
MsgBox "z1.doc not active": End
End If
On Error GoTo 0
With zObj ' now we're talking to Word
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
.Selection.Find.Text = sFind
.Selection.Find.Replacement.Text = sReplace
.Selection.Find.Forward = True
.Selection.Find.Wrap = 1 ' wdFindContinue
.Selection.Find.Format = False
.Selection.Find.MatchCase = False
.Selection.Find.MatchWholeWord = False
.Selection.Find.MatchWildcards = False
.Selection.Find.MatchSoundsLike = False
.Selection.Find.MatchAllWordForms = False
.Selection.Find.Execute Replace:=2 ' wdReplaceAll
End With
Exit Sub
err1:
MsgBox "Word not active": End
err2:
MsgBox "z1.doc not open": End
End Sub

 

[Guest]

Thanks for your help, Dave D-C!

' This is a start (works with Office97) - mainly for my benefit.
' Hope this helps you. Thanks for the post.

Option Explicit

Sub sub1()
' This assumes that Word is running and z1.doc is open and active.
' Word could be "created" if not running.
' z1.doc could be opened if not open.
' z1.doc could be activated if not active.
Dim zObj As Object, sFind$, sReplace$
sFind = Cells(1, 1)
sReplace = Cells(1, 2)
On Error GoTo err1
Set zObj = GetObject(, "Word.Application")
On Error GoTo err2
If Not zObj.Windows("z1.doc").Active Then
MsgBox "z1.doc not active": End
End If
On Error GoTo 0
With zObj ' now we're talking to Word
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
.Selection.Find.Text = sFind
.Selection.Find.Replacement.Text = sReplace
.Selection.Find.Forward = True
.Selection.Find.Wrap = 1 ' wdFindContinue
.Selection.Find.Format = False
.Selection.Find.MatchCase = False
.Selection.Find.MatchWholeWord = False
.Selection.Find.MatchWildcards = False
.Selection.Find.MatchSoundsLike = False
.Selection.Find.MatchAllWordForms = False
.Selection.Find.Execute Replace:=2 ' wdReplaceAll
End With
Exit Sub
err1:
MsgBox "Word not active": End
err2:
MsgBox "z1.doc not open": End
End Sub