如何将excel复制并粘贴到带有单词vba的单词

Question

I want to insert the Excel file at the seartain BOOkmark in the Word doc without opening Excel, automatically inserted when the Word doc opens.

1.I'm thinking to make a pop up window with a open file dialog bottom firstly. And my code is following: (but it only work in excel VBA doesn't work in word VBA how should I change the code so that I can do it in word??? )

Sub openfile()
Dim intChoice As Integer
Dim strPath As String
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
End Sub

2. Then I made a copy and paste bottom the code is as follows: (It also only work when l code it in excel how to change to word vba?)

    Sub CopyWorksheetsToWord() Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet Application.ScreenUpdating = False Application.StatusBar = "Creating new document..." Set wdApp = New Word.Application Set wdDoc = wdApp.Documents.Add For Each ws In ActiveWorkbook.Worksheets ws.UsedRange.Copy wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste Application.CutCopyMode = False wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter If Not ws.Name = Worksheets(Worksheets.Count).Name Then With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range .InsertParagraphBefore .Collapse Direction:=wdCollapseEnd .InsertBreak Type:=wdPageBreak End With End If Next ws Set ws = Nothing Application.StatusBar = "Cleaning up..." With wdApp.ActiveWindow If .View.SplitSpecial = wdPaneNone Then .ActivePane.View.Type = wdNormalView Else .View.Type = wdNormalView End If End With Set wdDoc = Nothing wdApp.Visible = True Set wdApp = Nothing Application.StatusBar = False End Sub 

Answer 1

This should get you started. Place the code below in your Word document in the 'ThisDocument' module.

---

Add Excel reference to your Word VBA. In the VBA editor go to Tools and then References. Check the box next to Microsoft Excel 14.0 Object Library.

---

Private Sub Document_Open()
    Dim intChoice As Integer
    Dim strPath As String

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    intChoice = Application.FileDialog(msoFileDialogOpen).Show

    If intChoice <> 0 Then
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    End If

    CopyWorksheetsToWord (strPath)
End Sub


Function CopyWorksheetsToWord(filePath As String)
    Dim exApp As Excel.Application
    Dim exWbk As Excel.Workbook
    Dim exWks As Excel.Worksheet
    Dim wdDoc As Word.Document

    Application.ScreenUpdating = False
    Application.StatusBar = "Creating new document..."

    Set wdDoc = ActiveDocument
    Set exApp = New Excel.Application
    exApp.Visible = False

    Set exWbk = exApp.Workbooks.Open(filePath)

    For Each exWks In exWbk.Worksheets
        exWks.UsedRange.Copy
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
        exApp.CutCopyMode = False
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
        If Not exWks.Name = exWbk.Worksheets(exWbk.Worksheets.Count).Name Then
            With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                .InsertParagraphBefore
                .Collapse Direction:=wdCollapseEnd
                .InsertBreak Type:=wdPageBreak
            End With
        End If
    Next exWks

    Application.StatusBar = "Cleaning up..."

    Set exWks = Nothing
    exWbk.Close
    Set exWbk = Nothing
    Set exApp = Nothing

    Application.StatusBar = False
    Application.ScreenUpdating = True
End Function

---

1. Save file as macro-enabled file (.docm)
2. Close word file
3. Open word file and the code will run. First thing you'll see is a file open box to select the Excel file.

Tested code but there is no error checking.

---

Update per comment

Bookmarks can be located by name using the following syntax: wdDoc.Bookmarks("Bookmark2").Range

In this case I inserted a bookmark and labeled it Bookmark2

Updated Function Code:

Function CopyWorksheetsToWord(filePath As String)
    Dim exApp As Excel.Application
    Dim exWbk As Excel.Workbook
    Dim exWks As Excel.Worksheet
    Dim wdDoc As Word.Document
    Dim bmRange As Range

    Application.ScreenUpdating = False
    Application.StatusBar = "Creating new document..."

    Set wdDoc = ActiveDocument
    Set exApp = New Excel.Application
    exApp.Visible = False

    Set exWbk = exApp.Workbooks.Open(filePath)

    For Each exWks In exWbk.Worksheets
        exWks.UsedRange.Copy

        Set bmRange = wdDoc.Bookmarks("Bookmark2").Range
        bmRange.Paste

        exApp.CutCopyMode = False
        wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
        If Not exWks.Name = exWbk.Worksheets(exWbk.Worksheets.Count).Name Then
            With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                .InsertParagraphBefore
                .Collapse Direction:=wdCollapseEnd
                .InsertBreak Type:=wdPageBreak
            End With
        End If
    Next exWks

    Application.StatusBar = "Cleaning up..."

    Set exWks = Nothing
    exWbk.Close
    Set exWbk = Nothing
    Set exApp = Nothing

    Application.StatusBar = False
    Application.ScreenUpdating = True
End Function

Since your looping through sheets you'll probably need to play with formatting and how your stacking each section in the document but this should get you going.