PDA

View Full Version : Help with creation of Word Document from Excel



Panik
01-28-2014, 01:21 PM
I was referred to this Forum by a member at MrExcel. I'm not sure if I should post in the Word or Exel forum. I chose excel as that is where I have the code (maybe I can post later as I have not posted enough to post a link).

I created code that used to work great in Excel 2003 several years ago. Now that I am running Excel 2010/ 2013, I get errors when trying to create a Word document from excel. I have posted the entire code below. Could someone please help me get this working. The The original Code is below. If you see the other thread where they tried to help, you can see they made a couple recommendations which did not fix the error. I continue to get the error "Compile Error: Can't find object or library". It starts with the ".Orientation = wdOrientLandscape". If I comment that line out, the error simply highlights the next line.

I have tripple checked to ensure the Word object library is referenced. I also modified some code per the recommendations at mrexcel. No luck.

Any help in fixing this is greatly appreciated.

-Jim

Panik
01-28-2014, 01:23 PM
I need to post 5 posts to post the code?

Panik
01-28-2014, 01:24 PM
Hope this is an OK way to do it.

Panik
01-28-2014, 01:24 PM
No. 4

Panik
01-28-2014, 01:25 PM
No. 5

Panik
01-28-2014, 01:27 PM
Original Code:


Generate Word Quotation

Sub CopyTableToWordDocument()
Dim wdApp As Word.Application




On Error Resume Next
' Try to open an existing instance of Word
Set wdApp = GetObject(, "Word.Application")


' Open new instance if no running instance exists
If wdApp Is Nothing Then
Set wdApp = GetObject("", "Word.Application")
End If


On Error GoTo 0
wdApp.Documents.Add
wdApp.Visible = True


With Word.ActiveDocument.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
End With


Word.Application.ActiveDocument.ActiveWindow.View.Zoom.PageFit = wdPageFitFullPage
wdApp.ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit


' Insert Hydro Logo on First Page


ThisWorkbook.Sheets("Customer Sheet").Shapes("HydroLogo").Select
Selection.Copy
With wdApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(7)
End With
wdApp.Selection.Paste
wdApp.Selection.TypeParagraph
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph


' Insert Service Center Information


wdApp.Selection.Font.Name = "Arial"
wdApp.Selection.Font.Size = 7
wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
wdApp.Selection.Font.Bold = wdToggle
With wdApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(7)
End With
wdApp.Selection.TypeText Text:="Hydro Inc."
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Range("ServiceCenter2").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Range("ServiceCenterStreet").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Range("ServiceCenterCity").Text & ", " & Range("ServiceCenterState").Text & " " & Range("ServiceCenterZip").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Phone:" & vbTab & Range("ServiceCenterPhone").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Fax:" & vbTab & Range("ServiceCenterFax").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="www.hydroinc.com"
wdApp.Selection.TypeParagraph
With wdApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(0)
End With
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph


' Insert Date
wdApp.Selection.Font.Name = "Arial"
wdApp.Selection.Font.Size = 10
wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
wdApp.Selection.TypeText Text:="Date:" & vbTab & _
Format(Date, "mmmm d, yyyy")
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph


' Insert Customer
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Range("CustCustomerName")
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Equipment Location:" & vbTab & Range("CustShipToStreet")
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & vbTab & vbTab & Range("CustShipToCity").Text & ", " & Range("CustShipToState").Text & " " & Range("CustShipToZip").Text
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph


' Insert Contact Info
wdApp.Selection.TypeText Text:="Attention:" & vbTab & vbTab & Range("QuoteName2").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & vbTab & vbTab & "e-mail:" & vbTab & Range("QuoteEmail2")
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & vbTab & vbTab & "Phone:" & vbTab & Range("QuotePhone2") & vbTab & vbTab & "Fax:" & vbTab & Range("QuoteFax2")
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph


' Insert Reference Info
wdApp.Selection.TypeText Text:="Reference:" & vbTab
wdApp.Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(1), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
wdApp.Selection.ParagraphFormat.TabStops(InchesToPoints(1)).Position = _
InchesToPoints(1.5)
wdApp.Selection.TypeText Text:="Customer RFQ #:" & vbTab & Range("CustomerRFQ1").Text
wdApp.Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(3), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
wdApp.Selection.TypeText Text:=vbTab
wdApp.Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(5), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
wdApp.Selection.TypeText Text:="Hydro Quote #:" & vbTab & Range("CustQuoteNum").Text
wdApp.Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(6.25), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
wdApp.Selection.ParagraphFormat.TabStops(InchesToPoints(6.25)).Position = _
InchesToPoints(6.5)
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & "Customer PO #:" & vbTab & Range("CustomerPO1").Text & vbTab & _
"Hydro Sales Order #:" & vbTab & Range("CustSalesOrderNum").Text
wdApp.Selection.TypeParagraph


' Insert Subject Info
wdApp.Selection.TypeParagraph
wdApp.Selection.ParagraphFormat.TabStops(InchesToPoints(1.5)).Clear
wdApp.Selection.ParagraphFormat.TabStops(InchesToPoints(3)).Clear
wdApp.Selection.ParagraphFormat.TabStops(InchesToPoints(5)).Clear
wdApp.Selection.ParagraphFormat.TabStops(InchesToPoints(6.5)).Clear
wdApp.Selection.TypeText Text:="Subject:" & vbTab & vbTab & _
"Repair of your " & Range("CustMake").Text & ", Model: " & Range("CustModel").Text
wdApp.Selection.TypeText Text:=", " & Range("Stages").Text & " Stage Pump"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & vbTab & vbTab & _
"Serial Number: " & Range("CustSerialNum").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph




' Insert Cover Text
wdApp.Selection.Font.Italic = wdToggle
wdApp.Selection.TypeText Text:= _
"Thank you for the opportunity to provide our services in the"
wdApp.Selection.TypeText Text:= _
" repair of your " & Range("CustMake").Text & " pump. The attached work scope and "
wdApp.Selection.TypeText Text:= _
"proposal is based on the results of a complete ""As Found"" in"
wdApp.Selection.TypeText Text:= _
"spection applied to this unit upon its arrival at Hydro's " & Range("ServiceCenter2").Text & "."
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:= _
"For your convenience, we have divided this proposal to inclu"
wdApp.Selection.TypeText Text:= _
"de the following sections; we believe that you will find thi"
wdApp.Selection.TypeText Text:= _
"s format to be helpful in reviewing our proposal."
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & "Section No. 1" & vbTab & _
"Detailed Recondition Requirements"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & "Section No. 2" & vbTab & _
"Detailed Parts Requirements"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & "Section No. 3" & vbTab & _
"Buy Out Requirments"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeBackspace
wdApp.Selection.TypeBackspace
wdApp.Selection.TypeBackspace
wdApp.Selection.TypeBackspace
wdApp.Selection.TypeBackspace
wdApp.Selection.TypeBackspace
wdApp.Selection.TypeText Text:="ements"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:=vbTab & "Section No. 4" & vbTab & _
"Pricing Summary and Commercial Terms"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:= _
"If you have any questions or need any additional information"
wdApp.Selection.TypeText Text:= _
" regarding this proposal, please feel free to contact us at "
wdApp.Selection.TypeText Text:="any time."
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="We look forward to your advisement."
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Sincerely,"
wdApp.Selection.InsertBreak Type:=wdPageBreak
Application.CutCopyMode = False


' Insert Recondition Parts by Starting New Page
ThisWorkbook.Sheets("Customer Sheet").Range("Recondition").Copy
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph
wdApp.Selection.Paste
wdApp.Selection.InsertParagraphAfter
wdApp.Selection.InsertBreak Type:=wdPageBreak
Application.CutCopyMode = False


' Insert New Parts by Starting New Page
ThisWorkbook.Sheets("Customer Sheet").Range("Parts").Copy
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph
wdApp.Selection.Paste
wdApp.Selection.InsertParagraphAfter
wdApp.Selection.InsertBreak Type:=wdPageBreak
Application.CutCopyMode = False


' Insert Buy Out Components by Starting New Page
ThisWorkbook.Sheets("Customer Sheet").Range("BuyOuts").Copy
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.TypeParagraph
wdApp.Selection.Paste
wdApp.Selection.InsertBreak Type:=wdPageBreak
Application.CutCopyMode = False


' Insert Pricing Summary and Commercial Terms
wdApp.Selection.EndKey Unit:=wdStory
wdApp.Selection.Font.Name = "Arial"
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:= _
"Section 4 - Pricing Summary and Commercial Terms"
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:= _
"Total Cost for Recondition Requirements....................."
wdApp.Selection.TypeText Text:="..........................................." & _
vbTab & "$" & Range("CustReconTotal").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:= _
"Total Cost for New Part Requirements........................"
wdApp.Selection.TypeText Text:="............................................" & _
vbTab & "$" & Range("CustPartsTotal").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:= _
"Total Cost for Buy Out Requirements........................."
wdApp.Selection.TypeText Text:="............................................." & _
vbTab
If wdApp.Selection.Font.Underline = wdUnderlineNone Then
wdApp.Selection.Font.Underline = wdUnderlineSingle
Else
wdApp.Selection.Font.Underline = wdUnderlineNone
End If
wdApp.Selection.TypeText Text:="$" & Range("CustBuyOutTotal").Text
If wdApp.Selection.Font.Underline = wdUnderlineNone Then
wdApp.Selection.Font.Underline = wdUnderlineSingle
Else
wdApp.Selection.Font.Underline = wdUnderlineNone
End If
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:= _
"Total Repair Cost..........................................."
wdApp.Selection.TypeText Text:= _
"........................................................" & vbTab & "$" & Range("CustGrandTotal").Text
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Delivery:"
wdApp.Selection.Font.Bold = wdToggle
With wdApp.Selection.ParagraphFormat
.LeftIndent = InchesToPoints(2)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
With wdApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(-2)
End With
wdApp.Selection.TypeText Text:=vbTab & "We Estimate a Shipment of " & Range("LeadTime0").Text & " from our " & Range("ServiceCenter2").Text
wdApp.Selection.TypeText Text:= _
" after receipt of an Electronic or Hard Copy Purchase Orde"
wdApp.Selection.TypeText Text:="r."
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Shipping Charges:"
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:=vbTab & _
Range("Freight0").Text & ", pending other arrangements."
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="F.O.B."
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:=vbTab & Range("ServiceCenterCity").Text & ", " & Range("ServiceCenterState").Text
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Payment Terms:" & vbTab
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Net 30"
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Pricing:"
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:=vbTab & "Less Applicable Taxes"
wdApp.Selection.TypeParagraph
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:="Warranty:"
wdApp.Selection.Font.Bold = wdToggle
wdApp.Selection.TypeText Text:=vbTab & _
"Our Standard New Unit Warranty of One (1) year from shipmen"
wdApp.Selection.TypeText Text:="t date shall apply to this order."
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:= _
"Thanks again for the opportunity to provide a proposal "
wdApp.Selection.TypeText Text:="to repair your " & Range("CustMake").Text & " pump."
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Sincerely,"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Name"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Title"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Phone"
wdApp.Selection.TypeParagraph
wdApp.Selection.TypeText Text:="Fax"


Set wdApp = Nothing



End Sub

Panik
01-28-2014, 01:28 PM
Modified some code to:


wdApp.ActiveDocument.ActiveWindow.View.Zoom.PageFit = wdPageFitFullPage

and


With WdApp.ActiveDocument.PageSetup .Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
End With

mancubus
01-28-2014, 02:06 PM
hey Panik. welcome to the forum.

can you post your workbook with sampla data.

click Go Advanced. scroll down. click Manage Attachments.

perhaps one of our members can help you.

Dave
01-28-2014, 08:50 PM
Here's the link. Good luck. Dave
http://www.mrexcel.com/forum/excel-questions/752140-help-creation-word-document-excel.html

mancubus
01-28-2014, 11:07 PM
it's a cross post link. not a workbook. :) you should copy this thread's link to mrexcel as well. so someone is working on it in mrexcel.

snb
01-29-2014, 02:04 AM
Are you familiar with Word's builtin facility 'mailmerge' ?

Panik
01-29-2014, 01:58 PM
Thanks mancubus! Hopefully the workbook attaches, it is large. Anyway on the "Customer Sheet" tab, I have a Macro Button at the top. "Generate Quote" Click it and you will see the error. I had to zip as the original is 8MB, I had to remove several tabs just to zip it under 1MB.

I sure hope we can figure this out.

Thanks for all the help.

Panik
01-29-2014, 01:59 PM
snb, No, not familiar.

snb
01-29-2014, 03:11 PM
Start familiarising yourself with it.
You won't need any VBA when you master lesson 6 in Word (mailmerge).

Dave
01-30-2014, 07:02 AM
I trialled your wb and get the same missing reference error. The references indicate that the Word library is checked. I changed the priority pf the Word reference so that it is below the MS forms 2.0 library and the error message stopped. My reference list indicates that I'm missing the common control and calendar control so I can' t run the code... I assume that you are not misssing these? Anyways, it seems like it just a matter or changing the priority of your Word reference. HTH. Dave

Panik
01-30-2014, 03:43 PM
Dave, forgive my ignorance, but how do I change the priority of my Word reference? Yes I have the other controls.

Dave
01-30-2014, 06:20 PM
In the VBA editor, click tools, references, highlight the Word reference, then click the priority up arrow (twice in this instance), then click OK. Close the references then re-open to ensure that the priority has changed. Dave