Блог

Я пытался скопировать текст из документа Excel в документ Word с помощью макроса VBA, однако он продолжает отказывать в, казалось бы, случайных точках и выдает одно из двух разных сообщений об ошибке. Кажется, нет никакой рифмы или причины относительно того, где он потерпит неудачу или какое сообщение об ошибке он мне выдаст.

Во-первых, это образец электронной таблицы Excel, которую я использую:

Вот как выглядит документ Word при запуске макроса:

Иногда он завершается ошибкой со следующим сообщением об ошибке, но при попытке его отладки на самом деле не отображается строка, в которой происходит сбой:

В другое время — произойдет сбой со следующим сообщением об ошибке. Когда он выходит из строя с этим сообщением — вы можете отладить его, и это покажет, что он выходит из строя в одной из четырех строк .Вставить:

Наконец, вот мой макрос 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 amp; ". "
            Range("A" amp; myIndex).Copy
            .Paste
            
           ' insert response A, B and C data
            .TypeText "a) "
            Range("B" amp; myIndex).Copy
            .Paste
            .TypeText "b) "
            Range("C" amp; myIndex).Copy
            .Paste
            .TypeText "c) "
            Range("D" amp; 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:DatatestDocument.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 amp; ". " amp; Range("A" amp; myIndex) amp; vbCr
    
    ' insert response A, B and C data
    .InsertAfter "a) " amp; Range("B" amp; myIndex) amp; vbCr
    .InsertAfter "b) " amp; Range("C" amp; myIndex) amp; vbCr
    .InsertAfter "c) " amp; Range("D" amp; myIndex) amp; 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" amp; 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 amp; ". "
            
            ' 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
...