CODEWITHSUNDEEP
vbaexcelms-wordpowerpoint
eMTy
eMTy

Reputation: 387

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

I have an excel workbook that acts as a dashboard and run code to open multiple word files with one table, copies the table and then pastes it to a specific slide in a power point.

I am trying to figure out how to copy table from word and paste it in power point as enhanced metafile picture. So far when I have my code, I get an error (object doesn't support this method) on the pastespecial code:

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

Right now I am thinking of a work around where the image is first pasted back into a spare sheet in excel and then copied and pasted again into the power point. I would like to avoid that step.

My full code below:

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

Update #1

Updated the code to go around the issue like this...but its slow:

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

Upvotes: 0

Views: 2658

Answers (1)

Jeanno
Jeanno

Reputation: 2859

Under tools in VBA editor, select references > Microsoft PowerPoint Object Library

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

Upvotes: 1

Related Questions