LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 49
Default Insert a table into word

Hi,

i have got the following code that takes infomation in the spreadsheet
and puts it into a word document. This includes a header and a table.
All the infomation goes into word OK until it puts in the table from
excel, It goes back to the top of the document and pastes over the top
of everything else. Does anyone have a solution to this problem?

Thanks



sub quote()

Application.DisplayAlerts = False

ActiveSheet.Unprotect

' Creates memos in word using Automation (late binding)

Dim name As Range, project As Range, quotation As Range, quoteby
As Range, amount As Range
Dim quote As String
Dim SaveAsName As String

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim rngDoc As Word.Range
Dim data As Range
Dim wdSelect As Word.Selection





Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("H:\Administration\quote.dot ")
wrdApp.Visible = True
Set wdSelect = wrdDoc.ActiveWindow.Selection
Set rngDoc = wrdDoc.Content



' Information from worksheet
Set name = Sheets("quote").Range("b3")
Set project = Sheets("quote").Range("b4")
Set quoteby = Sheets("quote").Range("b6")
Set quotation = Sheets("quote").Range("b7")
Set amount = Sheets("quote").Range("G5")


' Determine the file name
SaveAsName = quotation & ".doc"

ChDrive ("H:\")
ChDir "H:\Administration"
Workbooks.Open FileName:="H:\Administration\quotes.xls"


Columns("A:A").Select
Selection.Find(What:=quotation, After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, 6).Select
ActiveCell.Value = Date


ActiveCell.Offset(0, 1).Select
ActiveCell.Value = amount
ActiveWorkbook.Save
ActiveWorkbook.Close


quote = Sheets("quote").Range("a9",
Sheets("quote").Range("g65536").End(xlUp)).Address
Range(quote).Copy





With wrdDoc



.Bookmarks("header").Range.InsertAfter (project)





With rngDoc
.Font.name = "Times New Roman"
.Font.Size = 10
.Font.Bold = True
.Font.Italic = False
.ParagraphFormat.Alignment = 1
.Text = "QUOTATION"

.Font.name = "Times New Roman"
.Font.Size = 10
.Font.Bold = False
.Font.Italic = False
.ParagraphFormat.Alignment = 0

End With


.Content.PasteExcelTable True, True, True
.Content.InsertParagraphBefore
.Content.InsertBefore "QUOTATION"
.Content.InsertBefore "Here is a example test line #" & i
.Content.InsertParagraphBefore
.Content.InsertParagraphBefore
.Content.InsertParagraphBefore
.Content.InsertParagraphBefore
.Content.InsertParagraphBefore


.Content.InsertAfter "To:" & vbTab & name
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Date:" & vbTab & _
Format(Date, "mmmm d, yyyy")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Project:" & vbTab & project
.Content.InsertParagraphAfter
.Content.InsertAfter "Our quotation reference " & quotation & ",
please quote on any correspondence"
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Further to your recent enquiry, we are
pleased to submit our budget quotation for the supply only fixed by
others of the following,"
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter













.Content.InsertAfter "Grand Total:" & " " & Format(amount,
"£#,##0.00")




.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter

.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Please note the following, "
.Content.InsertAfter "Any welding may show signs of distortion/
discoloration after the welding process."
.Content.InsertParagraphAfter
.Content.InsertAfter "Should you place an order we will need to be
advised where the finishers may jig."
.Content.InsertParagraphAfter
.Content.InsertAfter "These parts include top hat section, joint
straps and stiffening sections."
.Content.InsertParagraphAfter
.Content.InsertAfter "If successful with the above quote we
suggest that you contact our production manager Mr Peter Marano to
mutually agree a delivery period."
.Content.InsertParagraphAfter
.Content.InsertAfter "VAT to be added and charged at the current
rates."
.Content.InsertParagraphAfter
.Content.InsertAfter "Only items specifically itemised have been
allowed for."
.Content.InsertParagraphAfter
.Content.InsertAfter "Price includes for delivery within 100 miles
of St. Albans, Herts, should you wish us to deliver outside this area
then this will be charged extra to the above stated price."
.Content.InsertParagraphAfter
.Content.InsertAfter "If tolerances are critical then please
contact us to discuss your requirements."
.Content.InsertParagraphAfter
.Content.InsertAfter "Price subject to receiving full order and
hard copy working drawings."
.Content.InsertParagraphAfter
.Content.InsertAfter "Settlement terms strictly 30 days from date
of invoice and subject to continued acceptance by our trade insurers."
.Content.InsertParagraphAfter
.Content.InsertAfter "Any order that results from this quote will
be subject to our terms and conditions on the following page."
.Content.InsertParagraphAfter
.Content.InsertAfter "We look forward to receiving your further
instruction."
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Yours faithfully,"
.Content.InsertParagraphAfter



.SaveAs ("H:\Administration\") & (SaveAsName)


'.ActiveDocument.SaveAs FileName:=SaveAsName

End With


wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing



MsgBox Records & " Quotation was created and saved in " & "H:
\Administration\" & "\" & SaveAsName

Application.DisplayAlerts = True
Sheets("hide").Visible = False
Sheets("rate table").Visible = False

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
Application.CutCopyMode = False

ActiveWorkbook.Save
Unload Me
ActiveWorkbook.Close


End Sub

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Link table from excel to word using word VBA [email protected] Excel Discussion (Misc queries) 7 January 9th 07 05:57 PM
Link table from excel to word using word VBA [email protected] Excel Programming 7 January 9th 07 05:57 PM
Write data to Access table with INSERT when table has auto number Hokievandal Excel Programming 1 December 20th 06 01:19 AM
Insert Row into MS Word Table Andibevan[_4_] Excel Programming 0 August 15th 05 06:55 PM
Excel VBA - Insert Word Table problem PaulC Excel Programming 1 May 31st 04 01:46 PM


All times are GMT +1. The time now is 12:32 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"