Question

我想在Word文档中的seartain BOOkmark处插入Excel文件而不打开Excel，在Word文档打开时自动插入。

1.我正在考虑先打开一个带有打开文件对话框的弹出窗口。我的代码如下：（但它只适用于excel VBA在单词VBA中不起作用我应该如何更改代码以便我可以在单词中执行？）

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

这应该让你开始。将下面的代码放在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

将文件另存为启用宏的文件（.docm）
关闭word文件
打开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

由于您循环浏览工作表，您可能需要使用格式设置以及如何堆叠文档中的每个部分，但这样可以帮助您实现目标。

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

1 个答案: