将文本从excel复制到word一直失败

问题描述

我一直在尝试使用 VBA 宏将文本从 Excel 文档复制到 Word 文档 - 但是它总是在看似随机的点上失败,并且它会吐出两种不同的错误消息之一。关于它会在哪里失败或它会给我什么错误消息,似乎没有押韵或理由。

首先,这是我正在使用的示例 Excel 电子表格:

Excel Spreadsheet

这是运行宏时Word文档的样子:

Word Export

有时它会失败并显示以下错误消息 - 但是当您尝试调试它时 - 它实际上并没有显示发生故障的行:

First Error Message

在其他时候 - 它会失败并显示以下错误消息。当它失败并显示此消息时 - 您可以调试它并显示它在四个 .Paste 行之一上失败:

Second Error Message

最后,这是我的 VBA 宏:

Sub copyFromExcelToWordUsingcopyPaste()

    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim myIndex As Integer
    Dim questionNumber As Integer
    Dim lastRow As Long

    lastRow = Cells(Rows.Count,1).End(xlUp).Row ' this figures out the last used row by counting backwards (up) from the bottom until it finds some data
    questionNumber = 1
   
     ' create a new word application and word document
    On Error Resume Next
    Set wrdApp = Getobject(,"Word.Application")
    On Error GoTo 0
    If wrdApp Is nothing Then
        Set wrdApp = CreateObject("Word.Application")
    End If
    wrdApp.Visible = True
    
    Set wrdDoc = wrdApp.Documents.Add ' create a new document
        
    ' insert the question and response data
    For myIndex = 2 To lastRow
        With wrdDoc.ActiveWindow.Selection
            ' insert the question data
            .TypeText questionNumber & ". "
            Range("A" & myIndex).copy
            .Paste
            
           ' insert response A,B and C data
            .TypeText "a) "
            Range("B" & myIndex).copy
            .Paste
            .TypeText "b) "
            Range("C" & myIndex).copy
            .Paste
            .TypeText "c) "
            Range("D" & myIndex).copy
            .Paste
            
            ' insert a new paragraph and increment to the next question
            .TypeParagraph
            questionNumber = questionNumber + 1
        End With
    Next
    
    ' Save the word document into the WordExport Folder
    wrdDoc.SaveAs "c:\Data\testDocument.docx",FileFormat:=12 'wdFormatXMLDocument
    wrdDoc.Close ' close the document
    
    Set wrdDoc = nothing
    Set wrdApp = nothing
End Sub

如果有人能就为什么这一直失败提供一些帮助 - 将不胜感激。

解决方法

这不能回答您的问题,但它是一种将数据从 Excel 传输到 Word 而不是复制和粘贴的替代方法。

...
With wrdDoc.Content
    ' insert the question data
    .InsertAfter questionNumber & ". " & Range("A" & myIndex) & vbCr
    
    ' insert response A,B and C data
    .InsertAfter "a) " & Range("B" & myIndex) & vbCr
    .InsertAfter "b) " & Range("C" & myIndex) & vbCr
    .InsertAfter "c) " & Range("D" & myIndex) & vbCr
    
    ' insert a new paragraph and increment to the next question
    .InsertAfter vbCr
    questionNumber = questionNumber + 1
End With
...

更新:同样,这不能回答您的问题,但您可以将整个范围复制到一个中,然后在 Word 中操作数据。

...
' copy the question and response data
Range("A2:D" & lastRow).Copy

' paste to Word as a table
wrdDoc.Content.Paste

With wrdDoc.Tables(1)
    ' align table text left
    .Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    
    ' loop through table rows
    For questionNumber = 1 To .Rows.Count
        With .Rows(questionNumber)
            ' insert question number
            .Cells(1).Range.InsertBefore questionNumber & ". "
            
            ' insert response letters
            .Cells(2).Range.InsertBefore "a) "
            .Cells(3).Range.InsertBefore "b) "
            .Cells(4).Range.InsertBefore "c) "
            
            ' insert new line at end of row
            .Cells(4).Range.InsertAfter vbCr

            ' ensure no page break occurs between question/response
            .Range.ParagraphFormat.KeepWithNext = True
            .Cells(4).Range.ParagraphFormat.KeepWithNext = False
        End With
    Next
    
    ' split table into 1 column
    .Range.Cells.Split NumColumns:=1
    
    ' convert table to text
    .ConvertToText Separator:=wdSeparateByParagraphs
End With
...