如何复制和粘贴excel word到单词vba

Question

我想在Word文档的seartain BOOkmark中插入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 

然后我做了一个复制和粘贴底部的代码如下：（它也只工作当升在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

这应该得到y你开始了。将下面的代码放在'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 

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