我在Word 2010 VBA(我是VBA中的新手)中编写了一个简单的代码,它只需要从Excel中获取一些表格和一个图形,然后将它们作为OLE对象粘贴到Word中。 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
答案 0 :(得分:0)
这是一个棘手的问题,因为宏录制器在这种情况下没有帮助。
解决方案不是仅引用ChartObjects集合中的项目,而是引用其Chart.ChartArea。
从
更改您的代码pgmExcel.ActiveWorkbook.Sheets(1).ChartObjects(1).Copy
到
pgmExcel.ActiveWorkbook.Sheets(1).ChartObjects(1).Chart.ChartArea.Copy
它应该按预期工作。