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
它应该按预期工作。
我在 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
它应该按预期工作。