Hi,
The code below creates a new word document using data from a sheet, however, i can only insert singles cells and can't work out how to inject a range of cells i.e. a table?? any suggestions??
This Line returns an error
QUOTE = Data.Range(Cells(ROWPOSTOP, 1), Cells(ROWPOSBOT, 1)).Value
Sub MakeDoc()
Dim WordApp As Object
Dim Data As Range, message As String, Para1 As String
Dim QuoteDetails As String, TSNUM As String, PROREF As String, CLIENT As String, QUOTE As String
Dim ROWPOSTOP As Integer
Dim ROWPOSBOT As Integer
Dim SaveAsName As String
'Start Word and create an object
Set WordApp = CreateObject("Word.Application")
'Information from worksheet
Set Data = Sheets("Summary").Range("A1:J36")
Para1 = "PLACE FIRST PARAGRAPH IN HERE"
message = "This is a Test. This is a Test.This is a Test.This is a Test.This is a Test."
'Update status bar progress message
Application.StatusBar = "Creating Quote"
'Assign current data to variables
QuoteDetails = "99"
Region = "1"
TSNUM = Data.Cells(6, 3).Value
CLIENT = Data.Cells(7, 3).Value
PROREF = Data.Cells(8, 3).Value
'Create Row Position Constants
Set lastcell = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
For X = 1 To lastcell.Row
If Cells(X, 1) = "Part Code" Then Exit For
Next
ROWPOSTOP = X
For Z = 1 To lastcell.Row
If Cells(Z, 1) = "Prices are valid for three months from the date shown above." Then Exit For
Next
ROWPOSBOT = Z
QUOTE = Data.Cells(ROWPOSTOP + 1, 1).Value
'QUOTE = Data.Range(Cells(ROWPOSTOP, 1), Cells(ROWPOSBOT, 1)).Value
'Determine the file name
SaveAsName = ThisWorkbook.Path & "\" & TSNUM & ".doc"
'Send commands to Word
With WordApp
.Documents.Add
With .Selection
.Font.Size = 12
.Font.Bold = True
.ParagraphFormat.Alignment = 3
.TypeText Text:="Trinity Protection Systems, Little Bridge Business Park"
.TypeParagraph
.TypeParagraph
.Font.Size = 12
.ParagraphFormat.Alignment = 0
.Font.Bold = False
.TypeText Text:="Date:" & vbTab & _
Format(Date, "mmmm d, yyyy")
.TypeParagraph
.TypeText Text:="Quote Number: " & TSNUM & ""
.TypeParagraph
.TypeText Text:="Client: " & CLIENT & ""
.TypeParagraph
.TypeText Text:="Site: " & PROREF & ""
.TypeParagraph
.TypeText Para1
.TypeParagraph
.TypeText Text:="" & QUOTE & ""
End With
.ActiveDocument.SaveAs Filename:=SaveAsName
End With
'Quit the object
WordApp.Quit
Set WordApp = Nothing
'Reset status bar
Application.StatusBar = ""
MsgBox "Quote " & TSNUM & " was created and saved in " & ThisWorkbook.Path
End Sub
Thanks,
Bookmarks