在EXCEL 2010中复制和粘贴范围VBA PowerPoint

这是我目前使用的代码。 我想复制和粘贴范围到一个特定的Powerpoint。 我可以使用下面的代码来做到这一点，但质量不是很好，我希望有另一种解决方法。

Sub This () Dim PPApp As PowerPoint.Application Dim PPPres As PowerPoint.Presentation Dim PPSlide As PowerPoint.Slide ' Reference existing instance of PowerPoint Set PPApp = New PowerPoint.Application Set pptPres = PPApp.Presentations.Open("C:\Desktop\Template.pptx") Set PPApp = GetObject(, "Powerpoint.Application") ' Reference active presentation Set PPPres = PPApp.ActivePresentation Sheets("Test").Select Range("B6:Q46").CopyPicture ' Paste the range With PPPres.Slides(18).Shapes.PasteSpecial .Top = 86.8969 .Left = 19.98417 .Height = 150.7964 .Width = 600.5262 End With End Sub 

我试过这个：

 Sheets("Test").Select Range("B6:Q46").Copy ' Paste the range With PPPres.Slides(18).PasteSpecial .Top = 86.8969 .Left = 19.98417 .Height = 150.7964 .Width = 600.5262 End With 

但这是行不通的，我想知道是否有办法做到这一点。 当我复制和粘贴我也想保持格式。

加成

我已经做了一些在线研究，我已经看到，如果我想保持范围的格式，不想复制范围作为一个图片，那么我需要使用：

 ppapp.CommandBars.ExecuteMso ("PasteExcelTableSourceFormatting") 

但我无法得到这个工作这是我正在做的事情：

  Sub CreatePP() Dim ppapp As PowerPoint.Application Dim ppPres As PowerPoint.Presentation Dim ppSlide As PowerPoint.Slide Dim ppTextBox As PowerPoint.Shape Dim iLastRowReport As Integer Dim sh As Object Dim templatePath As String Set ppapp = GetObject(, "PowerPoint.Application") Set pptPres = PPApp.Presentations.Open("C:\Desktop\Template.pptx") ppapp.Visible = True Sheets("Tables").Select Range("A27:D48").Copy ppapp.ActivePresentation.Slides (5) ppapp.CommandBars.ExecuteMso ("PasteExcelTableSourceFormatting") 

Answer 1

尝试将其粘贴为EnhancedMetafile？

 Set myShapeRange = PPPres.Slides(18).PasteSpecial(ppPasteEnhancedMetafile) With myShapeRange .Top = 86.8969 .Left = 19.98417 .Height = 150.7964 .Width = 600.5262 End With 

函数参数通过https://msdn.microsoft.com/en-us/library/office/ff745158.aspx