Проблема с буфером обмена при копировании из Excel в текстовый документ - PullRequest
Новая
       23

Проблема с буфером обмена при копировании из Excel в текстовый документ

0 голосов
/ 31 октября 2018

Я вроде как новичок в VBA, но я немного поработал в прошлом.

Я пытаюсь скопировать текст в ячейках Excel (ячейки с A1 по A66) в текстовый документ. Цель этой операции состоит в том, чтобы позволить пользователю скопировать его и вставить в другое место как TEXT. Если пользователь скопирует его непосредственно из Excel, он будет вставлен как TABLE.

Это мой код: 

Private Sub Bouton1_Click()

    Dim objWord As New Word.Application
    With objWord
        .Documents.Add
        Application.Wait (Now + TimeValue("0:00:01") / 2)
        Worksheets("Description2").Cells(1, 1).Copy
        Application.Wait (Now + TimeValue("0:00:01") / 2)
        .Selection.PasteSpecial xlPasteValues
        .Visible = True
    End With

    Dim i As Integer
    For i = 2 To 66
    If Worksheets("Description2").Cells(i, 1) = Worksheets("Description2").Cells(i + 1, 1) Then Exit For
        With objWord
            Application.Wait (Now + TimeValue("0:00:01") / 2)
            Worksheets("Description2").Cells(i, 1).Copy
            Application.Wait (Now + TimeValue("0:00:01") / 2)
            .Selection.PasteSpecial xlPasteValues
            .Visible = True
        End With
    Next i

    objWord.Application.Activate
    objWord.Application.WindowState = wdWindowStateMaximize

End Sub

Этот код работает примерно в 70% случаев. Когда это не работает, я получаю эту ошибку (или вариант, но всегда касающийся буфера обмена):

Ошибка времени выполнения "4605": этот метод или свойство недоступны потому что буфер обмена пуст или недействителен.

Также иногда открывается случайное окно OneDrive.

Я добавил строки application.wait, чтобы попытаться замедлить копирование / прошлое, но это не так уж и много.

У вас есть какие-нибудь советы, чтобы сделать мой код более надежным?

Большое спасибо, Louis

1 Ответ

0 голосов
/ 31 октября 2018

Если вы хотите вставить текст, возможно: 

Sub CopyAsTextToWord()
    Dim wordApp As New Word.Application

    With wordApp
        .Visible = True
        .Documents.Add

        Worksheets("Description2").Range("A1:A66").Copy
        .Selection.PasteSpecial DataType:=wdPasteText
    End With
End Sub

Если, с другой стороны, вы хотите вставить каждую ячейку по одной (это похоже на исходный код, не уверен), возможно, это немного другой подход, избегая буфера обмена. Считайте диапазон в массив, выполните итерацию по нему, а затем используйте Selection.TypeText для последовательного «вставки» каждого элемента. Вероятно, можно сделать более надежным. 

Sub TransferAsText()
    Dim wordApp As New Word.Application

    With wordApp
        .Visible = True
        .Documents.Add

        Dim arr()
        arr = Worksheets("Description2").Range("A1:A66").Value

        Dim i As Long
        For i = LBound(arr, 1) To UBound(arr, 1)
            .Selection.TypeText Text:=CStr(arr(i, 1))
        Next i
    End With
End Sub
...