vbams-wordword-2010

PasteSpecial - Error 5342 - Specified data type is unavailable (Word 2010 code)


I wrote a simple code in Word 2010 VBA (I am new in VBA), which simply takes some tables and one graph from Excel and paste them into Word as OLEobjects. Everythink works fine, except when the code tries to paste the chart from Excel into Word. I got the "Error 5342 - the specified data type is unavailable". You can find it in the final part of the code.

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

Solution

  • This is a tricky one as Macro recorder doesn't help in this case.

    The solution is not to refer just to an item from a ChartObjects collection, but to its Chart.ChartArea.

    Change your code from

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

    to

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

    and it should work as expected.