Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Pasting Multiple times in Word

Status
Not open for further replies.

kklaus

Technical User
Dec 8, 2004
36
US
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!
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
 
Hi kklaus,

Code:
With wdDoc
    :
    :
'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

1. .EndKey is a method of the Word Selection (wdApp.Selection.EndKey etc.), not the document.

2. Selection as coded is the Excel Selection (you need wdApp.Selection)

Code:
With wdDoc
'I'm trying move to end of document so I don't paste over what I just copied above

    :
    :

.Range.PasteSpecial Link:=False, DataType:=3, _
Placement:=wdInLine, DisplayAsIcon:=False

End With

Although you've tried to move the Selection, you are pasting here to wdDoc.Range which is the whole document. You would really be better not using Selection at all but changing to this should give what you want (providing you correct the first bit as well):

Code:
With wdDoc
'I'm trying move to end of document so I don't paste over what I just copied above

    :
    :

[b]wdApp.Selection[/b].Range.PasteSpecial Link:=False, DataType:=3, _
Placement:=wdInLine, DisplayAsIcon:=False

End With

I haven't studied all the code so please come back if it still isn't right and I'll run it.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
You rock!!!

Both pictures are showing in Word now. The only problem I'm having now is that the 2nd picture is on the first page and the first picture is on the 2nd page. Is there a way to get the second paste to come after the 1st pasted picture?

THANKS!!!!
 
Hi kklaus,

What if you change the first paste to be ..

wdApp.Selection.Range.Paste etc

as well? Then everything is working with the Selection

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
Thanks for all your help!!! I ended up just pasting my last cells first, and my first cells last. So everything is good now! Here's my code for anyone else who may find it helpful. It's cool. It takes one worksheet in a workbook and pastes it into a Word Doc. Then attaches that Word Doc to an email.
Thanks Again!!
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("A268:F297").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
    wdApp.Selection.Range.PasteSpecial Link:=False, DataType:=3, _
    Placement:=wdInLine, DisplayAsIcon:=False
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
End With


With ActiveSheet
Set source = .Range("A64:F267").SpecialCells(xlCellTypeVisible)
source.Copy
End With


With wdDoc
    wdApp.Selection.Range.PasteSpecial Link:=False, DataType:=3, _
    Placement:=wdInLine, DisplayAsIcon:=False
End With
    
With ActiveSheet
    Set source = .Range("A1:F63").SpecialCells(xlCellTypeVisible)
    source.Copy
End With


With wdDoc
    wdApp.Selection.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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top