вставка изображения от excel to powerpoint, которая подходит к макету

Question

У меня есть Excel Picture Shape, и я хочу вставить его в mny приложение PowerPoint, которое имеет специальный макет, который я уже указал.

Sub ExcelShapePowerpoint() 
    Dim PowerPointApp As Object 
    Dim myPresentation As Object 
    Dim mySlide As Object 
    Dim myShape As Object 

Dim pastedPic1 As Shape 

Set DestinationSheet1 = Workbooks("myExcelFile.xlsm").Sheets("myExcelSheet") 
Set pastedPic1 = DestinationSheet1.Shapes(10) 
    On Error Resume Next 

Set PowerPointApp = GetObject(class:="PowerPoint.Application") 
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 

'Handle if the PowerPoint Application is not found 
    If Err.Number = 429 Then 
    MsgBox "PowerPoint could not be found, aborting." 
    Exit Sub 
    End If 

On Error GoTo 0 

    Application.ScreenUpdating = False 

    Set myPresentation = PowerPointApp.Presentations.Add 
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly 
    With myPresentation.PageSetup 

.SlideWidth = 961 

.SlideHeight = 540 

End With 

    pastedPic1.Copy 


    mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile 
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count) 

'Set position: 
    myShape.Left = -15 

    myShape.Top = 11 

    PowerPointApp.Visible = True 
    PowerPointApp.Activate 

    Application.CutCopyMode = False 

End Sub 

Как видно из кода, макет уже установлен. Теперь я хочу, чтобы pastedpic1 полностью соответствовал макету PowerPoint.

Что мне делать?

Answer 1

Чтобы масштабировать форму myShape до размера слайда, используйте:

With myShape 
    .Top = 0 
    .Left = 0 
    .Width = ActivePresentation.PageSetup.SlideWidth 
    .Height = ActivePresentation.PageSetup.SlideHeight 
End With 

Обратите внимание, что в зависимости от соотношения сторон фигуры и слайд, растяжения может произойти. Это можно решить с помощью методов обрезки.

Answer 2

У меня была аналогичная проблема, но я сделал другой подход: Я создал шаблон PowerPoint, где я добавил подстановки изображений в места назначения, где нужно вставить изображения. Преимущество такого подхода заключается в том, что вы можете редактировать макет в PowerPoint и не должны возиться с размерами пикселей в базовом коде.

Следующий пример в VBScript, но могут быть переданы на VBA легко:

1. Открыть шаблон PowerPoint:

   Dim powerPoint, presentation 
   Set powerPoint = CreateObject("PowerPoint.Application")  
   Set presentation = powerPoint.Presentations.open("C:\template.pptx") 
   

2. Выберите Заполнитель, и вставить изображение:

   Dim slide, view, image, placeholder 
   Set view = m_presentation.Windows(1).View 
   Set slide = m_presentation.Slides(slideId) 
   view.GotoSlide(slide.SlideIndex) 
   Set placeholder = slide.Shapes(shapeName) 
   placeholder.Select() 
   view.Paste() 
   slide.Application.CommandBars.ExecuteMso("PictureFitCrop") 
   

3. Увеличьте изображение, чтобы оно соответствовало размеру pla ceholder:

   slide.Application.CommandBars.ExecuteMso("PictureFitCrop")