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

Question

Я написал простой код в Word 2010 VBA (я новичок в VBA), который просто берет некоторые таблицы и один граф из Excel и вставляет их в Word как OLEobjects. Everythink работает отлично, за исключением случаев, когда код пытается вставить диаграмму из 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 

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