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