I'm having a problem pasting from Excel to Word. I paste cells A1:F63 as a picture with no problem. When I copy and paste cells A64:F267, it pastes over my first picture. I haven't been able to successfully move to the end of the document or add a page break then paste the 2nd set of cells. Everything I've tried gives me..."Object doesn't support this property or method".
Please help me see what I am doing wrong.
Thanks!
Please help me see what I am doing wrong.
Thanks!
Code:
Private Sub CommandButton1_Click()
Sub Export_Word_Attach_Outlook()
Dim source As Range
Dim wdApp As Object
Dim wdDoc As Object
Dim strdate As String
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
'Create a hidden instance of Word
Set wdApp = CreateObject("Word.Application")
'Add a document.
Set wdDoc = wdApp.Documents.Add
With ActiveSheet
Set source = .Range("A1:F63").SpecialCells(xlCellTypeVisible)
source.Copy
End With
'Here's where I tried to name the .doc file from a cell on the sheet
strname = ThisWorkbook.Sheets("Quote Letter").Range("F10").Value & " Quote Letter"
With wdDoc
wdDoc.PageSetup.LeftMargin = "0.5"
wdDoc.PageSetup.RightMargin = "0.5"
wdDoc.PageSetup.TopMargin = "0.5"
wdDoc.PageSetup.BottomMargin = "0.5"
'Paste the source-range into the active document as a picture
.Range.PasteSpecial Link:=False, DataType:=3, _
Placement:=0, DisplayAsIcon:=False
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
'This didn't work so I commented it out
'.EndKey Unit:=wdLine, Extend:=wdMove
'This didn't work so I commented it out
'Selection.InsertBreak Type:=wdPageBreak
End With
With ActiveSheet
Set source = .Range("A64:F267").SpecialCells(xlCellTypeVisible)
source.Copy
End With
With wdDoc
'I'm trying move to end of document so I don't paste over what I just copied above
'(Cells A1:F63). If I don't get to a new page or the end of the document
'this second set of cells is pasting over my first picture.
'When I leave this code in I'm getting a message saying
' "Object doesn't support this property or method".
'Selection.EndKey Unit:=wdStory
' With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
' .Collapse Direction:=wdCollapseEnd
' .InsertBreak Type:=wdPageBreak
' End With
.Range.PasteSpecial Link:=False, DataType:=3, _
Placement:=wdInLine, DisplayAsIcon:=False
End With
With wdDoc
'Save & Close the document
.SaveAs ThisWorkbook.Path & "\" & strname & ".doc"
.Close
End With
'Close the hidden instance of Word
wdApp.Quit
Application.CutCopyMode = False
strbody = "Enter Text Here"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = ThisWorkbook.Sheets("Quote Letter").Range("B16").Value
.Subject = "Quote for " & ThisWorkbook.Sheets("Quote Letter").Range("F10").Value
.Body = strbody
.Attachments.Add ThisWorkbook.Path & "\" & strname & ".doc"
.Display
End With
'Release objects from memory.
Set wdDoc = Nothing
Set wdApp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
'Delete the Word-document.
Kill ThisWorkbook.Path & "\" & strname & ".doc"
End Sub