Insert Excel Table to Word and replace some text

[Deekappa]

I have the below code to create a quote letter in Word from an Excel workbook and it works great, however, I also want the same macro to insert a table from my Excel workbook to the same Word document. Is this possible?


I've had a look through the forums and I was able to find various examples of inserting tables to new word documents, but I wasn't sure how to combine that with the code I already have.


Thanks in advance!

Sub CreateQuoteLetter()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim thisWb As Workbook
    
    Set thisWb = ActiveWorkbook
    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True


    Set wDoc = wApp.Documents.add(Template:="I:\Mark B\New Job Template Resources\Custom Office Templates\Certifed Quote Template.dotm", NewTemplate:=False, DocumentType:=0)


    With wDoc
        .Application.Selection.Find.Text = "<quote_number>"
        .Application.Selection.Find.Execute
        .Application.Selection = Worksheets("Job Information").Range("K4")
        .Application.Selection.EndOf
        
        .Application.Selection.Find.Text = "<client_name>"
        .Application.Selection.Find.Execute
        .Application.Selection = Worksheets("Job Information").Range("C3")
        .Application.Selection.EndOf
        
        .Application.Selection.Find.Text = "<billing_address_line1>"
        .Application.Selection.Find.Execute
        .Application.Selection = Worksheets("Job Information").Range("C5")
        .Application.Selection.EndOf
        
        .Application.Selection.Find.Text = "<billing_address_line2>"
        .Application.Selection.Find.Execute
        .Application.Selection = Worksheets("Job Information").Range("C6")
        .Application.Selection.EndOf
        
        .Application.Selection.Find.Text = "<contact_person>"
        .Application.Selection.Find.Execute
        .Application.Selection = Worksheets("Job Information").Range("C4")
        .Application.Selection.EndOf
        
        .Application.Selection.Find.Text = "<contact_email>"
        .Application.Selection.Find.Execute
        .Application.Selection = Worksheets("Job Information").Range("C11")
        .Application.Selection.EndOf


        .SaveAs2 Filename:=thisWb.Path & ("\1. Quotation\") & Worksheets("Job Information").Range("K4") & (".docm"), _
        FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
    End With


End Sub

</contact_email></contact_person></billing_address_line2></billing_address_line1></client_name></quote_number>

 

[Deekappa]

I think I need somehting like this, combined with the formula I already have.

Sub PopulateColumninWord()


    Dim wdApp  As Object
    Set wdApp = GetObject(, "Word.Application")
    Set wdDoc = wdApp.ActiveDocument


    'Copy range from Excel to Word
    ThisWorkbook.Sheets(Quote).Range("A1:D14").Copy
    wdDoc.Range(wdDoc.Tables(1).Cell(1, 1).Range.Start, _
                wdDoc.Tables(1).Cell(2, 1).Range.End).PasteAndFormat (22)


    Set wdApp = Nothing
    Set wdDoc = Nothing

 

[Macropod]

Try something based on:

Sub CreateQuoteLetter()
Dim wApp As New Word.Application, wDoc As Word.Document
Dim xlWb As Workbook, xlWkSht As Worksheet
Set xlWb = ActiveWorkbook: Set xlWkSht = xlWb.Worksheets("Job Information")
With wApp
  .Visible = True
  Set wDoc = .Documents.Add _
    (Template:="I:\Mark B\New Job Template Resources\Custom Office Templates\Certifed Quote Template.dotm")
  With wDoc
    With .Range
      .Find.Text = "<quote_number>"
      .Find.Execute
      If .Find.Found Then .Text = xlWkSht.Range("K4").Value
      .Find.Text = "<client_name>"
      .Find.Execute
      If .Find.Found Then .Text = xlWkSht.Range("C3").Value
      .Find.Text = "<billing_address_line1>"
      .Find.Execute
      If .Find.Found Then .Text = xlWkSht.Range("C5").Value
      .Find.Text = "<billing_address_line2>"
      .Find.Execute
      If .Find.Found Then .Text = xlWkSht.Range("C6").Value
      .Find.Text = "<contact_person>"
      .Find.Execute
      If .Find.Found Then .Text = xlWkSht.Range("C4").Value
      .Find.Text = "<contact_email>"
      .Find.Execute
      If .Find.Found Then .Text = xlWkSht.Range("C11").Value
      .Find.Text = "<table_data>"
      .Find.Execute
      If .Find.Found Then
        xlWkSht.Range("A1:J10").Range.Copy
        .PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      End If
    End With
    .SaveAs2 Filename:=xlWb.Path & "\1. Quotation\" & xlWkSht.Range("K4").Value & ".docx", _
      FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
  End With
End With
End Sub

Note the general code improvements. The code for inserting an Excel range as a table in the above is:

      .Find.Text = "<table_data>"
      .Find.Execute
      If .Find.Found Then
        xlWkSht.Range("A1:J10").Range.Copy
        .PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      End If

In addition to varying the PasteExcelTable parameters, you might also explore one of Word's other paste methods.

 

[Deekappa]

I got an error message when I first tried it, so I made the changes below and fixed the error.

The issue I have now, is that it is only changing the first bit of text, <quote_number>, and none of the other sections. Not sure what I'm missing to fix this bit.

      If .Find.Found Then .Text = xlWkSht.Range("C11").Value
      .Find.Text = "<table_data>"
      .Find.Execute
      If .Find.Found Then
        xlWkSht.Range("A1:J10").Copy
        .PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      End If
    End With
  .SaveAs2 Filename:=xlWb.Path & "\1. Quotation\" & xlWkSht.Range("K4").Value & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
  [B]End With[/B]
End With
End Sub

 

[Macropod]

As I said, I made some general improvements to your code. Did you try running the entire sub? In case the items are not in the search order, try inserting:
.Find.Wrap = wdFindContinue
before:
.Find.Text = "<quote_number>"