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

时间:2016-06-27 17:12:02

标签: excel vba excel-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")

1 个答案:

答案 0 :(得分:0)

尝试将其粘贴为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

的功能参数