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

Question

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

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

2. 然后我进行了复制并粘贴到底部，代码如下：（ 它仅在l在excel中将其编码为如何更改为单词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

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

---

将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 ： 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

由于遍历工作表，您可能需要使用格式设置以及如何堆叠文档中的每个部分，但这应该可以助您一臂之力。