PasteSpecial - ошибка 5342 - указанный тип данных недоступен (код Word 2010)

Question

Я написал простой код в Word 2010 VBA (я новичок в VBA), который просто берет некоторые таблицы и один график из Excel и вставляет их в Word как объекты OLE. Все работает нормально, кроме случаев, когда код пытается вставить диаграмму из Excel в Word. Я получил сообщение "Ошибка 5342 - указанный тип данных недоступен". Вы можете найти это в заключительной части кода.

Sub Copy_Tables_and_Graphs_OLE()

    '''' Variables Definition ''''
    Dim pgmExcel As Excel.Application
    Dim table As Word.table
    Dim month As String
    Dim year As String
    Dim path As String
    Dim monthyear As String
    Dim year_1 As String
    Dim monthyear_1 As String
    Dim path_1 As String
    Dim ultimate_path As String
    Dim range As String
    Dim sure As Integer
    Dim same As Integer
    Dim month_1 As String
    Dim n As String
    Dim Figure As String
    Dim BookmarkArray As Variant
    Dim i As Variant
    Dim lenght As Integer
    Dim chart As Object
    Dim fso As Object

    '''' Date Inputs ''''
    year = InputBox("Please insert year - yyyy")
    month = InputBox("Please insert month - mm")
    monthyear = year & month

    '''' Path Section ''''
    path = "hiddenpath" & year & "\\" & monthyear & "hidden path.xlsx"
    MsgBox ("Path Value is:" & path)
    sure = MsgBox("Confirm? - answer yes or no", vbYesNo)

    If sure = vbYes Then
        path = "hidden path" & year & "\\" & monthyear & "hidden path.xlsx"
        ultimate_path = path
    Else
        year_1 = InputBox("Then please insert the right - yyyy")
        month_1 = InputBox("Then please insert the right - mm")
        monthyear_1 = year_1 & month_1

        path_1 = "hidden path" & year_1 & "\\" & monthyear_1 & "hidden path.xlsx"
        ultimate_path = path_1
    End If

    '''' BookMarks ''''
    BookmarkArray = Array("Book1", "Book2", "Book3", "Book4")

    ''''For Each BookMark''''
    For i = LBound(BookmarkArray) To UBound(BookmarkArray)
        lenght = Len(BookmarkArray(i))
        n = Mid(BookmarkArray(i), lenght, 1)

        '''' Range Selection ''''
        If n = 1 Then
            range = "B4:E6"
        End If

        If n = 2 Then
           range = "B9:E11"
        End If

        If n = 3 Then
            range = "B14:E16"
        End If

        '''' Copy and Paste Excel Tables ''''
        Set pgmExcel = CreateObject("Excel.Application")

        pgmExcel.Workbooks.Open ultimate_path

        same = MsgBox("Figure n° " & n & " . Is the range the same of the previous time?", vbYesNo)

        If same = vbYes Then
            range = range
        Else
            range = InputBox("Could you please me provide the new range?")
        End If

        If i < 3 Then
            Dim s As Long

            s = Selection.Start

            pgmExcel.ActiveWorkbook.Sheets(1).range(range).Copy

            ActiveDocument.Bookmarks(i + 1).Select

            Selection.PasteSpecial Link:=True, Placement:=wdInLine, DataType:=wdPasteOLEObject

            pgmExcel.Quit

            MsgBox ("You copied range " & range & " from folder" & ultimate_path)    
        Else
            pgmExcel.ActiveWorkbook.Sheets(1).ChartObjects(1).Copy

            ActiveDocument.Bookmarks(i + 1).Select

''' !!!!   IN THE LINE BELOW I GET THE ERROR 5342 (Specified data type is unavailable)  !!!!!! '''''

            Selection.PasteSpecial Link:=True, Placement:=wdInLine, DataType:=wdPasteOLEObject, DisplayAsIcon:=False

            pgmExcel.Quit

            MsgBox ("You copied range " & range & " from folder" & ultimate_path)

            ActiveDocument.Save

            Set fso = CreateObject("Scripting.FileSystemObject")

            If Not fso.FolderExists(fldr_name) Then
                fso.CreateFolder (fldr_name)
            End If

            ActiveDocument.SaveAs2 FileName:="hidden path.docx", FileFormat:=wdFormatDocumentDefault

        End If

    Next i

End Sub

Answer 1

Это сложная задача, так как в этом случае макрос-рекордер не помогает.

Решение состоит не в том, чтобы ссылаться только на элемент из коллекции ChartObjects, а на его Chart.ChartArea.

Измените свой код с

pgmExcel.ActiveWorkbook.Sheets(1).ChartObjects(1).Copy

в

pgmExcel.ActiveWorkbook.Sheets(1).ChartObjects(1).Chart.ChartArea.Copy

и это должно работать как ожидалось.