如何使用word vba将excel复制并粘贴到word

我想在Word文档的seartain书签处插入Excel文件，而不打开Excel，当Word文档打开时自动插入

1.我想先做一个弹出窗口，底部有一个打开的文件对话框。我的代码如下：（但它只在excel中工作VBA在word VBA中不工作我应该如何更改代码以便在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

---

这应该让你开始。将下面的代码放在“ThisDocument”模块的Word文档中

---

将Excel引用添加到Word VBA。在VBA编辑器中，转到“工具”，然后转到“引用”。选中Microsoft Excel 14.0对象库旁边的框

---

---

由于在工作表中循环，您可能需要处理文档中每个部分的格式和堆叠方式，但这应该会让您开始工作。

这应该会让您开始工作。将下面的代码放在“ThisDocument”模块的Word文档中

---

将Excel引用添加到Word VBA。在VBA编辑器中，转到“工具”，然后转到“引用”。选中Microsoft Excel 14.0对象库旁边的框

---

---

由于在工作表中循环，您可能需要使用格式以及如何在文档中堆叠每个部分，但这应该可以让您继续工作。

您的代码缺乏基本逻辑。首先，只有打开MS Office文档时，VBA才能运行。是哪一个？在运行代码之前，无法打开对话框来选择文档。接下来，如果要从Word打开Excel，必须先运行Word，然后创建Excel应用程序。最后，如果要从对话框中选择Excel工作簿，可以从Word中选择。在将代码提交给其他人审查之前，您应该在代码中加入这么多的顺序。至少，你的意图将是/应该是清楚的。@Variatus-我认为你可能把事情复杂化了。OP声明“当单词打开时”。这告诉我，他们希望在打开事件

Document\u open（）

中使用代码，该事件会弹出一个文件选择框，在Excel不可见的情况下获取Excel数据，并将其插入打开的Word文档中。他们甚至给出了自己的代码位，并表示它可以在Excel中工作，但不能在Word中工作。@Variatus我认为Leila在这里需要的只是一个代码片段，它可以做同样的事情，但可以在Word文件中工作：它可以打开给定的Excel文件（对用户来说是打开但不可见的），并将内容从Excel文件复制到当前的Word文件。上面的代码已经做到了这一点，但它在excel文件中运行，并从excel文件中读取内容。将其复制到给定的word文件。您的代码缺乏基本逻辑。首先，只有打开MS Office文档时，VBA才能运行。是哪一个？在运行代码之前，无法打开对话框来选择文档。接下来，如果要从Word打开Excel，必须先运行Word，然后创建Excel应用程序。最后，如果要从对话框中选择Excel工作簿，可以从Word中选择。在将代码提交给其他人审查之前，您应该在代码中加入这么多的顺序。至少，你的意图将是/应该是清楚的。@Variatus-我认为你可能把事情复杂化了。OP声明“当单词打开时”。这告诉我，他们希望在打开事件

Document\u open（）

中使用代码，该事件会弹出一个文件选择框，在Excel不可见的情况下获取Excel数据，并将其插入打开的Word文档中。他们甚至给出了自己的代码位，并表示它可以在Excel中工作，但不能在Word中工作。@Variatus我认为Leila在这里需要的只是一个代码片段，它可以做同样的事情，但可以在Word文件中工作：它可以打开给定的Excel文件（对用户来说是打开但不可见的），并将内容从Excel文件复制到当前的Word文件。上面的代码已经完成了，但它在excel文件中运行，并从excel文件中读取内容。将其复制到给定的word文件。感谢您的帮助！我可以再问一件事吗？如何根据书签的名称将表格粘贴到书签？非常感谢您的帮助！谢谢你的帮助！我可以再问一件事吗？如何根据书签的名称将表格粘贴到书签？非常感谢您的帮助！

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

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

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