如何將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

由於遍歷工作表，您可能需要使用格式設置以及如何堆疊文檔中的每個部分，但這應該可以助您一臂之力。