这是我目前使用的代码。我想将范围复制并粘贴到特定的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")
答案 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
的功能参数