Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Link table from excel to word using word VBA | Excel Discussion (Misc queries) | |||
Link table from excel to word using word VBA | Excel Programming | |||
Write data to Access table with INSERT when table has auto number | Excel Programming | |||
Insert Row into MS Word Table | Excel Programming | |||
Excel VBA - Insert Word Table problem | Excel Programming |