Thread: [Solved] Is this possible to create?
View Single Post
 
Old 04-30-2018, 06:30 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

IMHO, your project is over-engineered. There is no need for a mailmerge (or your Data worksheet) for this project. Indeed, given what you've posted, I'd have to wonder why Excel is involved at all - but that's another matter.

All you really need do is assign some bookmark names to your 'Plan Template' document (which really should be saved as a Word template (i.e. a dotx-format file), then use code like:
Code:
Sub Demo()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlSht As Worksheet, StrTmplt As String, StrDocNm As String
StrTmplt = "C:\Users\" & Environ("Username") & "\Desktop\Plan Template.dotx"
If Dir(StrTmplt) = "" Then Exit Sub
Set xlSht = Worksheets("Form")
StrDocNm = Application.ActiveWorkbook.Path & "\" & xlSht.Range("A1").Value & ".docx"
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Add(Template:=StrTmplt, Visible:=False)
Call UpdateBookmark(wdDoc, "Client", xlSht.Range("C12").Text)
Call UpdateBookmark(wdDoc, "Product", xlSht.Range("C14").Text)
Call UpdateBookmark(wdDoc, "Role", xlSht.Range("C15").Text)
Call UpdateBookmark(wdDoc, "Start_Date", xlSht.Range("C22").Text)
Call UpdateBookmark(wdDoc, "End_Date", xlSht.Range("D22").Text)
With wdDoc
    'update any cross-references to the bookmarks
    .Fields.Update
    'save & close
    .SaveAs2 Filename:=StrDocNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Sub UpdateBookmark(wdDoc As Word.Document, StrBkMk As String, StrTxt As String)
Dim BkMkRng As Range
With wdDoc
  If .Bookmarks.Exists(StrBkMk) Then
    Set BkMkRng = .Bookmarks(StrBkMk).Range
    BkMkRng.Text = StrTxt
    .Bookmarks.Add StrBkMk, BkMkRng
  End If
End With
Set BkMkRng = Nothing
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote