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

Question

我想在不打开 Excel 的情况下将 Excel 文件插入 Word doc 中的 seartain BOOkmark，当 Word doc 打开时自动插入。

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

1. 然后我复制并粘贴底部代码如下：（也只有在excel中编码时才有效如何更改为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

这应该可以帮助您入门。将下面的代码放在“ThisDocument”模块的 Word 文档中。

---

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

---

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. 将文件另存为启用宏的文件 (.docm)
2. 关闭word文件
3. 打开word文件，代码将运行。您首先会看到一个文件打开框，用于选择 Excel 文件。

已测试代码但没有错误检查。

---

每条评论更新

可以使用以下语法按名称定位书签：wdDoc.Bookmarks("Bookmark2").Range

在这种情况下，我插入了一个书签并将其标记为 Bookmark2

更新功能代码：

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

由于您循环浏览工作表，您可能需要处理格式以及如何堆叠文档中的每个部分，但这应该可以帮助您。