发送Excel图表到PowerPoint质量和大小

这是我将图表发送到特定位置的代码如下：

Sub This() Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Set PPApp = New PowerPoint.Application Set pptPres = PPApp.Presentations.Open("C:\Template.pptx") Set PPApp = GetObject(, "Powerpoint.Application") ' Reference active presentation Set PPPres = PPApp.ActivePresentation ' Copy the range as a picture Sheets("Plots").ChartObjects("Chart Name").Copy ' Paste the range With PPPres.Slides(10).Shapes.PasteSpecial ' Align pasted chart .Align msoAlignCenters, True .Align msoAlignMiddles, True End With End Sub 

所以这就是假设它打开一个特定的PowerPoint幻灯片，并发送图表幻灯片10.我的问题是，有没有办法将情节发送到一个特定的位置，并使其一定的大小？

Answer 1

亚当，请尝试下面的代码，与我在我的电脑上完成的testing一起使用。

图表位置和大小根据我在最后添加的4行中input的值进行了修改。

 Sub This() Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Set PPApp = New PowerPoint.Application Set pptPres = PPApp.Presentations.Open("C:\Template.pptx") ' Reference active presentation Set PPPres = PPApp.ActivePresentation ' Copy the range as a picture Worksheets("Plots").ChartObjects("Chart Name").Copy Set PPSlide = PPApp.ActivePresentation.Slides(10) ' Paste the Chart With PPSlide.Shapes.PasteSpecial .Top = 100 .Left = 120 .Height = 200 .Width = 400 End With End Sub 

Answer 2

 Sub This() Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide Set PPApp = New PowerPoint.Application Set pptPres = PPApp.Presentations.Open("C:\Template.pptx") Set PPApp = GetObject(, "Powerpoint.Application") ' Reference active presentation Set PPPres = PPApp.ActivePresentation ' Copy the range as a picture Sheets("Plots").ChartObjects("Chart Name").Copy ' Paste the range With PPPres.Slides(10).Shapes.PasteSpecial ' Align pasted chart .Top = 100.84976 .Left = 85.98417 .Height = 120.7964 .Width = 546.5262 End With End Sub 

PasteSpecial具有.Top .Left等特点。 所以这些可以用来alignment和调整照片的大小。 我也注意到，如果您使用Paste而不是Paste PasteSpecial那么照片质量会更差。