Pasting Excel data into Word at current cursor position

**gonefishing** · 06-22-2009, 03:16 PM

Hello,

I am trying to write an Excel vba script which pastes data into a word document. I have already made a great deal of progress by searching this and other forums, but now I seem to be stuck. Maybe one of you can help me out.

Here's how one should be able to use the script:
The user has multiple Excel documents available [which all contain this macro, as they were generated from the same template by a third-party software (LabView)].
The user is already working on a Word document, typing text until he decides that he wants to add some information from one of the Excel sheets. To do this, he changes to Excel, clicks on the button running the script, and the required information is pasted into the Word document at the present cursor position.

Here's what I got so far:

' [Here goes the code to select the part of the excel sheet which contains the data]
    Selection.Copy

    Dim wrdApp As Word.Application
    Dim wrdDocOutput As Word.Document

' Start Word
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
    End If
    On Error GoTo Errorhandler:
    
' copy data into the active document
    Set wrdDocOutput = wrdApp.ActiveDocument
    wrdDocOutput.Range(0, 1).PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
    :=wdInLine, DisplayAsIcon:=False
    
    
Errorhandler:
    With Err
        If .Number <> 0 Then MsgBox "You got error #" & .Number & Chr(13) & Chr(13) & .Description
    End With

    Set wrdApp = Nothing
    Set wrdDocOutput = Nothing

It works fine except that it always inserts the data right at the beginning of the Word document, which is not a big surprise because I have told the script to do so by specifiying range(0,1):

wrdDocOutput.Range(0, 1).PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
    :=wdInLine, DisplayAsIcon:=False

Now how can I find out the current cursor position in the Word document? After doing some research in the Word VBA forums, I tried to use something along the line of

cursorposition = wrdApp.ActiveDocument.Selection.Range
' or
cursorpostion = wrdApp.ActiveDocument.Selection

but the Excel VBA script always shows an error message ("Does not support this property or method"). Do you know how to do this?

Thanks in advance,
gonefishing

**gonefishing** · 06-23-2009, 04:44 AM

No answers yet - is the question too simple or too tricky?

Anyway, in the meanwhile I found out how to paste at the end of the document, which is already a lot more useful:

wrdApp.ActiveDocument.Range(wrdApp.ActiveDocument.Content.End - 1).PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
        :=wdInLine, DisplayAsIcon:=False

But still it would be much more convenient if I could just paste at the current cursor position, and I would be glad for any help...

**gonefishing** · 06-23-2009, 08:57 AM

I have solved the problem myself now.

This command does the trick:

    wrdApp.Application.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
       :=wdInLine, DisplayAsIcon:=False

And this is the whole script, which works now, for the record:

Sub copy_table()
'
' copy_table Makro
'



'   Copy Excel data
    Range("A10:L10").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
        
'   Define variable
    
    Dim wrdApp As Word.Application

'   Switch to Word Application
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
    End If
    On Error GoTo Errorhandler:
    
'   Paste
    wrdApp.Application.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
       :=wdInLine, DisplayAsIcon:=False
   
Errorhandler:
    With Err
        If .Number <> 0 Then MsgBox "You got error #" & .Number & Chr(13) & Chr(13) & .Description
    End With

    Set wrdApp = Nothing
    
End Sub