VBA，如何将单词 table 作为图片（增强型图元文件）粘贴到幻灯片？

Question

我有一个用作仪表板的 excel 工作簿和运行使用一个 table 打开多个 word 文件的代码，复制 table 然后粘贴它到幻灯片中的特定幻灯片。

我想弄清楚如何从 word 中复制 table 并将其作为增强图元文件图片粘贴到 PowerPoint 中。到目前为止，当我有我的代码时，我在 pastespecial 代码上收到错误（对象不支持此方法）：

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

现在我正在考虑一种解决方法，首先将图像粘贴回 excel 中的备用 sheet，然后再复制并粘贴到电源插座中。我想避免那一步。

有谁知道如何将 table 作为图片（增强型图元文件）从 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

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

VBA，如何将单词 table 作为图片（增强型图元文件）粘贴到幻灯片？

VBA, how to paste word table as picture (enhanced metafile) to a power point?

excel

powerpoint

vba

ms-word