Отправка Excel таблицу, чтобы PowerPoint Качество и размер

Question

Это код, который я для отправки карт в определенном месте следующее:

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

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 и так далее. Таким образом, они могут использоваться для выравнивания и изменения размера фотографии. Я также заметил, что если вы используете Paste, а не PasteSpecial, то качество фотографии хуже.

Answer 2

Адам, попробуйте следующий код, хорошо работает с тестами, которые я провел на своем ПК.

Расположение и размер диаграммы были изменены в соответствии со значениями, введенными в последние 4 строки, которые я добавил.

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