Excel VBA：将Excel范围粘贴为Powerpoint中的表

Question

I'm trying to automate the creation of powerpoint decks that i have to produce every month. I'm working in Excel VBA and cant figure out how to copy a range from excel, and paste it into a slide as a table.

Below is the code i have so far:

Sub Open_PowerPoint_Presentation()

Dim objPPT As Object, _
PPTPrez As PowerPoint.Presentation, _
pSlide As PowerPoint.Slide

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

Set PPTPrez = objPPT.Presentations.Open("file location")

Set pSlide = PPTPrez.Slides(4)

Dim RevenueDetail As Range
Dim RevenueDetailTable As Object

Sheets("Revenue By Type Slide").Activate

Set RevenueDetail = Range("B4:I18")
RevenueDetail.Copy

Set RevenueDetailTable = pSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)

With RevenueDetailTable

.Left = 43.99961
.Top = 88.61086
.Width = 471.2827
.Height = 395.2163

End With

End Sub

This works OK but it pastes the excel range as a picture which is not ideal. i'd like to paste it as a table which is what the default paste option does, but then i lose the ability to re-size and re-position it on the slide by the means that i'm currently using. I've been messing with this for awhile and can't seem to get it right.

if i modify

Set RevenueDetailTable = pSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)

and change it to

Set RevenueDetailTable = pSlide.Shapes.Paste

it pastes in the format i want but i cant figure out how to reposition and resize. any help would be greatly appreciated.

Answer 1

In your code change:

Set RevenueDetailTable = pSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)

With RevenueDetailTable

.Left = 43.99961
.Top = 88.61086
.Width = 471.2827
.Height = 395.2163

End With

Into:

pSlide.Shapes.Paste
For Each SHP In pSlide.Shapes
    If SHP.Type = 14 Then
        SHP.Left = 43.99961
        SHP.Top = 88.61086
        SHP.Width = 471.2827
        SHP.Height = 395.2163
    End If
Next

Obviously have SHP dimmed as Object

Answer 2

Fixed it... just needed to add a line "pSlide.Select" to select the slide i'm pasting into prior to pasting, and change .PasteSpecial(ppPasteEnhancedMetafile) to just .Paste...thanks for all help!!!!

Sub Open_PowerPoint_Presentation()

Dim objPPT As Object, _
PPTPrez As PowerPoint.Presentation, _
pSlide As PowerPoint.Slide

Dim RevenueDetail As Range
Dim RevenueDetailTable As Object

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

Set PPTPrez = objPPT.Presentations.Open("file location")

Set pSlide = PPTPrez.Slides(4)

Set RevenueDetail = Sheets("Revenue By Type Slide").Range("B4:I18")
RevenueDetail.Copy

pSlide.Select 'needed to add this line
Set RevenueDetailTable = pSlide.Shapes.Paste

With RevenueDetailTable

.Left = 43.99961
.Top = 88.61086
.Width = 471.2827
.Height = 395.2163

End With

End Sub