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

Question

我正在尝试自动创建每个月必须制作的PowerPoint卡座。 我正在使用Excel VBA，无法弄清楚如何从excel复制范围并将其粘贴到表格中。

下面是我到目前为止的代码：

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

效果很好，但是将excel范围粘贴为不理想的图片。 我想将其粘贴为表格，这是默认粘贴选项的作用，但随后我无法通过当前使用的方式来调整大小并将其重新放置在幻灯片上。 我已经弄了好一阵子，似乎无法正确解决。

如果我修改

Set RevenueDetailTable = pSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)

并将其更改为

Set RevenueDetailTable = pSlide.Shapes.Paste

它以我想要的格式粘贴，但我无法弄清楚如何重新定位和调整大小。 任何帮助将不胜感激。

Answer 1

在您的代码更改中：

Set RevenueDetailTable = pSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)

With RevenueDetailTable

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

End With

成：

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

显然SHP变暗为Object

Answer 2

修复它...只需在粘贴之前添加一行“ pSlide.Select”以选择我要粘贴的幻灯片，然后将.PasteSpecial（ppPasteEnhancedMetafile）更改为.Paste ...感谢所有帮助！ ！

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