Поправки к коду для копирования диапазона в виде картинки

Question

У меня есть код, который отлично работает при копировании значения одной отдельной ячейки в закладку в сохраненном документе Word. Я хочу изменить этот код, чтобы я мог скопировать диапазон ячеек и вставить его в виде рисунка в закладку в текстовом документе.

Dim objWord As Object
Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet3")

    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True

    objWord.Documents.Open "C:\Users\Christopher.Ellis\Desktop\VBA Testing\CPA Test\Master\CE1.docx" ' change as required

    With objWord.ActiveDocument
        .Range.Text = ws.Range("B2:G23").CopyPicture
        .Range.Bookmarks.Item("ContactWOP1").Range.Paste Type:=wdChartPicture

    End With

    Set objWord = Nothing


End Sub

Answer 1

В Word, как и в Excel, важно использовать объекты . Таким образом, код ниже объявляет и создает и объект для цели Word.Document, а также цели (закладки) Word.Range.

Используя объект Document, открываемый документ можно установить непосредственно на объект, поэтому нет необходимости полагаться на неопределенное свойство ActiveDocument. С объектом Range можно снова поднять эту целевую позицию, если требуется.

Метод CopyPicture следует использовать в Excel при копировании диаграммы, если это должен быть статический рисунок в документе Word (а не объект диаграммы). Это помещает изображение в буфер обмена Windows, чтобы его можно было вставить в документ. (Невозможно назначить то, что вы копируете, на Range.Text в Word BTW.)

Dim objWord As Object
Dim ws As Worksheet
Dim doc as Object, rng as Object

    Set ws = ThisWorkbook.Sheets("Sheet3")
    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True
    Set doc = objWord.Documents.Open "C:\Users\Christopher.Ellis\Desktop\VBA Testing\CPA Test\Master\CE1.docx" ' change as required

    With doc
        ws.Range("B2:G23").CopyPicture
        '.Range.Text = ws.Range("B2:G23").CopyPicture
        Set rng = .Range.Bookmarks.Item("ContactWOP1").Range
        rng.PasteAndFormat Type:=wdChartPicture
    End With

    Set objWord = Nothing
End Sub