如何複製和粘貼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 

由於您循環瀏覽工作表，您可能需要使用格式化以及如何堆疊文檔中的每個部分，但這應該讓您繼續。