PasteSpecial - 错误 5342 - 指定的数据类型不可用(Word 2010 代码)

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

我在 Word 2010 VBA 中写了一个简单的代码(我是 VBA 的新手),它只是从 Excel 中提取一些表格和一张图表并将它们粘贴到 Word 中OLE 对象。 Everythink 工作正常,除非代码试图将图表从 Excel 粘贴到 Word 中。我得到了 "Error 5342 - the specified data type is unavailable"。您可以在代码的最后部分找到它。

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

这是一个棘手的问题,因为宏记录器在这种情况下没有帮助。

解决方案不是仅引用 ChartObjects 集合中的项目,而是引用其 Chart.ChartArea。

更改您的代码
pgmExcel.ActiveWorkbook.Sheets(1).ChartObjects(1).Copy

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

它应该按预期工作。