【发布时间】：2015-02-23 21:04:35
【问题描述】：
我有一个 excel 工作簿，它充当仪表板并运行代码以使用一个表格打开多个 word 文件，复制表格，然后将其粘贴到 power point 中的特定幻灯片上。
我想弄清楚如何从 word 中复制表格并将其粘贴到 power point 作为增强的图元文件图片。到目前为止，当我有我的代码时，我在 pastespecial 代码上收到一个错误（对象不支持此方法）：
word_1.tables(1).Range.Copy
PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
现在我正在考虑一种解决方法，首先将图像粘贴回 excel 的备用工作表中，然后再复制并粘贴到 power point 中。我想避免这一步。
- 有谁知道如何将表格作为图片（增强的图元文件）从 word 粘贴到 简报？
我的完整代码如下：
Sub Debates_to_PP()
Dim destination_1 As Long
Dim objWord As Object
Set wb1 = ActiveWorkbook
'set slide destinations --- (needs to be a loop)
destination_1 = wb1.Sheets("Dash").Cells(12, 8).Value
'get path for PP
PPPath_name = wb1.Sheets("Dash").Cells(4, 10).Value
PPfile_name = wb1.Sheets("Dash").Cells(4, 11).Value
'Combine File Path names
PPfiletoopen = PPPath_name & "\" & PPfile_name
'Get path
Path_name = wb1.Sheets("Dash").Cells(12, 10).Value
file_name = wb1.Sheets("Dash").Cells(12, 11).Value
'Combine File Path names
filetoopen = Path_name & "\" & file_name
'Browse for a file to be open
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set word_1 = objWord.Documents.Open(filetoopen)
'open power point---------------------------------------------------------------------
Dim objPPT As Object
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
'Open PP file
objPPT.Presentations.Open Filename:=PPfiletoopen
Set PP = objPPT.activepresentation
'Copy and paste table-----------------------------------------------------------------
word_1.tables(1).Range.Copy
With PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
.Top = 100 'desired top position
.Left = 20 'desired left position
.Width = 650
End With
PP.Save
PP.Close
word_1.Close
End Sub
更新 #1
更新了代码以解决这样的问题......但速度很慢：
Sub Debates_to_PP()
Dim destination_1 As Long
Dim objWord As Object
Set wb1 = ActiveWorkbook
'get path for PP
PPPath_name = wb1.Sheets("Dash").Cells(4, 10).Value
PPfile_name = wb1.Sheets("Dash").Cells(4, 11).Value
'Combine File Path names for PP
PPfiletoopen = PPPath_name & "\" & PPfile_name
'open power point---------------------------------------------------------------------
Dim objPPT As Object
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
'Open PP file
objPPT.Presentations.Open Filename:=PPfiletoopen
Set PP = objPPT.activepresentation
'Start loop for Word Debate Files------------------------------------------------------
For i = 1 To 20
'Check if slide destination is identified
If IsNumeric(wb1.Sheets("Dash").Cells(11 + i, 8).Value) <> True Then GoTo here
'set slide destinations
destination_1 = wb1.Sheets("Dash").Cells(11 + i, 8).Value
'Get path
Path_name = wb1.Sheets("Dash").Cells(11 + i, 10).Value
file_name = wb1.Sheets("Dash").Cells(11 + i, 11).Value
'Combine File Path names
filetoopen = Path_name & "\" & file_name
'Browse for a file to be open
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set word_1 = objWord.Documents.Open(filetoopen)
'Copy and paste table-----------------------------------------------------------------
word_1.tables(1).Range.Copy
wb1.Worksheets("Place_Holder").Activate
wb1.Worksheets("Place_Holder").PasteSpecial Format:="Picture (Enhanced Metafile)", _
Link:=False, DisplayAsIcon:=False
wb1.Sheets("Place_Holder").Shapes(1).CopyPicture
With PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
.Top = 45 'desired top position
.Left = 30 'desired left position
.Width = 350
End With
wb1.Sheets("Place_Holder").Shapes(1).Delete
objWord.DisplayAlerts = False
objWord.Quit
objWord.DisplayAlerts = True
Next
here:
PP.Save
PP.Close
End Sub
【问题讨论】：
-
你定义了
ppPasteEnhancedMetafile的值，还是添加了对PPT对象库的引用？如果您不这样做，那么您的代码将不知道ppPasteEnhancedMetafile的含义... -
ActivePresentation.Slides(1).Shapes.PasteSpecial ppPasteEnhancedMetafile为我工作，您需要使用早期绑定并添加对 Powerpoint 对象库的引用 -
@Jeanno 您能否详细说明早期绑定的含义以及如何引用 PP obj lib？我是自学的，并不真正了解基础知识。谢谢你看这个！！！
-
@TimWilliams 有趣的想法，但是当我将图像从 excel 传递到 PP 而不参考 PPT obj lib 时，该代码有效......我想我没有指定它......谢谢你看!
-
@eMTy 在下面查看我的答案
标签： vba excel ms-word powerpoint