VBA，如何将Word表格作为图片（增强型图元文件）粘贴到电源点上？

我有一个Excel工作簿，充当仪表板并运行代码来打开多个单词文件与一个表，复制表，然后将其粘贴到特定的幻灯片中的电源点。

我想弄清楚如何从Word中复制表格并将其作为增强型图元文件图片粘贴到Power Point中。 到目前为止，当我有我的代码，我得到一个错误（对象不支持这种方法）在pastespecial代码：

word_1.tables(1).Range.Copy PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile) 

现在我正在考虑将图像首先粘贴到excel的备用表格中，然后复制粘贴到power point中。 我想避免这一步。

• 有谁知道如何粘贴表格作为一个图片（增强图元文件）从单词到PowerPoint？

我的完整代码如下：

 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 

Answer 1

在VBA编辑器的工具下，select参考> Microsoft PowerPoint对象库

 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 PowerPoint.Application Set objPPT = CreateObject("PowerPoint.Application") objPPT.Visible = True 'Open PP file objPPT.Presentations.Open Filename:=PPfiletoopen Dim PP as PowerPoint.Presentation Set PP = objPPT.activepresentation 'Copy and paste table----------------------------------------------------------------- word_1.tables(1).Range.Copy PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile) PP.Save PP.Close word_1.Close End Sub