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 wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy cells

Status
Not open for further replies.

alring

Technical User
Nov 11, 2005
18
DK
Hi all

I have a macro in Excel 2003 that opens a Word document. And it's working as it should. Now I also want that macro to copy some of the cells from Excel to Word. I have made Excel cells in Word and it's there I want to paste the cells from Excel.

Is that possible??

Mads
 
Hi mads,

I am going to postulate that when you say "I have made Excel cells in Word" that you have used the insert -> object and have inserted a workbook. If I'm wrong then this is going to be of no use to you!
It's not elegant and it's not pretty, but it does work (on my pc at least)

Sub excelToWord()
Dim wdApp As Word.Application
'Open the word document
Set wdApp = CreateObject("Word.Application")
wdApp.Documents.Open "C:\Temp\Doc1.doc"
wdApp.Visible = True
Workbooks("test.xls").Worksheets(1).Range("A1").Select
Selection.Copy
'Believe it or not if using office 2003 you have to use inline shapes
' but if using 2002 you can get away with just shapes.
'I guess thoses guys at Microsoft can tell you why 'cause I can't
wdApp.ActiveDocument.InlineShapes(1).Activate
'wdApp.ActiveDocument.Shapes(1).Activate
Range("A1").Select
ActiveSheet.Paste
' For some reason you've got to send the escape twice
SendKeys "{ESC}", True
SendKeys "{ESC}", True
'select and paste your next cell
Workbooks("test.xls").Worksheets(1).Range("B1").Select
Selection.Copy
wdApp.ActiveDocument.InlineShapes(1).Activate
'wdApp.ActiveDocument.Shapes(1).Activate
Range("B1").Select
ActiveSheet.Paste
End Sub

If your data is arranged in such a way that you only have to do one paste that would be best 'cause this macro really does kill my pc (guess it's not very efficient)!

Anyway HTH

Cheers

FOB
 
Hi FOB

Thank you for the help. I have changed the code a little bit. The code looks like this now:
Sub excelToWord_click()

'Open the word document
Set wdApp = CreateObject("Word.Application")
wdApp.documents.Open "H:\test_01.doc"
wdApp.Visible = True

'copy cells
Worksheets(1).Range("A1:B1").Select
Selection.Copy
'insert cells

wdApp.Activedocument.InlineShapes(1).Activate
Range("A1:B1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

End Sub

My problem now is that I nead to have the cells in the Word document in the header instead. How can I change/write the code so that the cells from Excel is pasted into the cells int he Word document header instead??

Alring
 
Try:
Code:
ActiveDocument.InlineShapes.AddOLEObject _
    ClassType:="Excel.Sheet", DisplayAsIcon:=False, _
    Range:=ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range

Assuming of course you want to put it in wdHeaderFooterPrimary of Section 1. If you need to put it in another header then simply change the Range.

Gerry
 
Hi

Now I have the way to paste my Excel cells into the Excel cells i have already in my Word header. The problem now is that the word document change to "Normal" view. I have tried to record a macro in Word and then paste that into my Excel macro. So that Word comes back to Print Layout View. But the macro don't do it. Maybe one of you know how the change the code. The code I have now is like this:

Sub excelToWord_click()
'copy cells
Worksheets(1).Range("A1:D2").Select
Selection.Copy
Range("A3").Select
'Open the word document
aNameAndPath = Range("A4")
Set wdApp = CreateObject("Word.Application")
wdApp.documents.Open Filename:=aNameAndPath
wdApp.Visible = True
'insert cells
With wdApp.activedocument.Sections(1)
.Headers(1).Range.inlineshapes(1).Activate
Range("A1:D2").Select
ActiveSheet.Paste
End With

If wdApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
wdApp.ActiveWindow.Panes(2).Close
End If
If wdApp.ActiveWindow.ActivePane.View.Type = wdNormalView Or wdApp.ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
wdApp.ActiveWindow.ActivePane.View.Type = wdPrintView
End If

Application.CutCopyMode = False

End Sub


If you want to run this macro then you have to make a Word document where you insert Excel cells in the header of the Word document first. Remember to save the document. In cells A4 in your Excel you can writh the path and filename of your Word document.

Alring
 
Sorry I forgot the code tabs:

Code:
Sub excelToWord_click()
    'copy cells
    Worksheets(1).Range("A1:D2").Select
    Selection.Copy
    Range("A3").Select
    'Open the word document
    aNameAndPath = Range("A4")
    Set wdApp = CreateObject("Word.Application")
    wdApp.documents.Open Filename:=aNameAndPath
    wdApp.Visible = True
    'insert cells
    With wdApp.activedocument.Sections(1)
        .Headers(1).Range.inlineshapes(1).Activate
        Range("A1:D2").Select
        ActiveSheet.Paste
    End With

    If wdApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        wdApp.ActiveWindow.Panes(2).Close
    End If
    If wdApp.ActiveWindow.ActivePane.View.Type = wdNormalView Or wdApp.ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        wdApp.ActiveWindow.ActivePane.View.Type = wdPrintView
    End If

    Application.CutCopyMode = False

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top