VBA，如何将单词表作为图片（增强的图元文件）粘贴到PowerPoint？

Question

我有一本excel工作簿，它充当仪表板并运行代码以使用一个表打开多个word文件，复制该表，然后将其粘贴到PowerPoint中的特定幻灯片中。

我试图弄清楚如何从单词中复制表格并将其粘贴到Power Point中作为增强的图元文件图片。 到目前为止，当我有了我的代码时，在粘贴特殊代码上出现了一个错误（对象不支持此方法）：

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

现在，我正在考虑一种解决方法，即首先将图像粘贴到excel中的备用工作表中，然后再复制并再次粘贴到PowerPoint中。 我想避免这一步。

• 有谁知道如何将表格作为图片（增强的图元文件）从单词粘贴到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编辑器中的工具下，选择引用> 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