PowerPoint VBA: копирование и вставка изображения, выравнивание по центру и растяжка по размеру страницы

Question

Я пытаюсь создать команду для автоматической экспорта PDF в PowerPoint.

У меня есть команда вставить фотографию, которая работает. Однако он просто вставляется в верхнюю левую часть экрана.

Я смотрю в Интернете, чтобы сценарий выровнялся по центру слайда и растянулся, чтобы соответствовать странице слайд-шоу. Я попытался записать его, но кажется, что PowerPoint не имеет функции записи.

Вот мой скрипт Copy + Paste, который работает ниже.

Sub PastePhoto() 
Dim Sld As Slide 
'Ensure focus is on slide 
Application.ActiveWindow.Panes(2).Activate 

Set Sld = Application.ActiveWindow.View.Slide 

On Error GoTo NoCopy 
    Sld.Shapes.PasteSpecial (ppPasteEnhancedMetafile) 
On Error GoTo 0 

Exit Sub 

NoCopy: 
MsgBox "There was nothing copied to paste!" 

Answer 1

Это должно быть все, что необходимо, чтобы вставить изображение в слайд и растянуть его, чтобы подогнать ширину слайда:

' Get the first slide... 
Dim sl As Slide 
Set sl = ActivePresentation.Slides(1) 

' Insert a picture at (0, 0)... 
Dim sh As Shape 
Set sh = sl.Shapes.AddPicture("c:\path\to\my.jpg", msoFalse, msoTrue, 0, 0) 

' Set the picture's width to that of a slide... 
sh.Width = ActivePresentation.PageSetup.SlideWidth 

И если вы хотите, чтобы отцентрировать его по вертикали:

sh.Top = (ActivePresentation.PageSetup.SlideHeight - sh.Height)/2 

Answer 2

После некоторой настройки я понял это:

Sub PastePhoto() 

Const ppLayoutBlank = 12 

Dim objWorkSheet As Worksheet 
Dim objRange As Range 
Set objWorkSheet = ThisWorkbook.ActiveSheet 

Range("A1:H18").Select 
Range("H18").Activate 
Selection.Copy 

Dim objPPT As PowerPoint.Application 
Dim objPresentation As Presentation 
Set objPPT = CreateObject("PowerPoint.Application") 
objPPT.Visible = True 

Set objPresentation = objPPT.Presentations.Add 
Set objSlide = objPresentation.Slides.Add(1, 1) 

objPresentation.Slides(1).Layout = ppLayoutBlank 

' paste as the meta file 
objPPT.Windows(1).View.PasteSpecial ppPasteMetafilePicture, msoTrue, , ,   "testlabel" 
End Sub