Как масштабировать, чтобы соответствовать изображениям, которые добавляются в заполнители изображений в powerpoint? - PullRequest
Новая
       26

Как масштабировать, чтобы соответствовать изображениям, которые добавляются в заполнители изображений в powerpoint?

1 голос
/ 01 июля 2019

В мастер-макете я определил местозаполнители, в которые добавляются изображения, но я не могу найти решение для масштабирования, чтобы соответствовать им.Причина для заполнителей изображений заключается в том, что изображения можно добавлять для разных макетов без добавления точных свойств местоположения (слева, сверху, ширины, высоты)

Мой текущий код выглядит следующим образом: 

Sub InsertPictures

ActivePresentation.Slides(1).Shapes.AddPicture FileName:="U:\xyz\EAP.png", _LinkToFile:=msoTrue
ActivePresentation.Slides(1).Shapes.AddPicture FileName:="U:\xyz\DAP_01.png",    LinkToFile:=msoTrue, _

End Sub

На рисунке ниже слева видно, как изображение добавляется с заполнителем изображения, а справа - как его добавить, когда оно установлено.

Comparison

Я нашел код, который выполняет «обрезку по размеру», но он работает только при выборе слайда: 

   Sub cropFit()
Dim osld As Slide
Dim oshp As Shape
On Error Resume Next
Set osld = ActiveWindow.View.Slide
If Not osld Is Nothing Then
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderPicture Then
oshp.Select
CommandBars.ExecuteMso ("PictureFitCrop")
End If 'picture placeholder
End If 'placehoder
Next oshp
End If ' Slide selected
End Sub

Как мне изменить код, которыйнепосредственно после добавления изображений с кодом выше (Sub Insert Pictures), изображения обрезаются, чтобы уместиться в режиме презентации?

Спасибо за вашу помощь заранее!

Ответы [ 2 ]

1 голос
/ 01 июля 2019

Что нам нужно сделать, так это получить заполнители изображений и назначить изображения этим заполнителям. Вы поместите свои имена файлов в массив, который может содержать столько строк, сколько заполнителей (я использовал 3 ниже, потому что вы говорите, что у вас есть 3 заполнителя изображений). Затем мы вставим картинки в эти заполнители и обрежем их по размеру. Я заимствовал понятия, используемые здесь и здесь . Итак, ваш код будет: 

Sub InsertPictures()

Dim FileNames(1 To 3) As String, Shps As Shapes, i As Integer

Set Shps = ActivePresentation.Slides(1).Shapes
FileNames(1) = "U:\xyz\EAP.png"
FileNames(2) = "U:\xyz\DAP_01.png"
' Filenames(3) = "Blah Blah Blah"
i = 1

For Each Shp In Shps.Placeholders
    ' You only need to work on Picture place holders
    If Shp.PlaceholderFormat.Type = ppPlaceholderPicture Then
        With Shp
            ' Now add the Picture
            Set s = Shps.AddPicture(FileNames(i), msoTrue, msoTrue, _
                            .Left, .Top, .Width, .Height)
            ' Insert DoEvents here specially for big files, or network files
            ' DoEvents halts macro momentarily until the
            ' system finishes what it's doing which is loading the picture file
            DoEvents
            s.Select
            CommandBars.ExecuteMso ("PictureFitCrop")
            i = i + 1
        End With
    End If
    If (i > UBound(FileNames)) Then Exit For
    If (FileNames(i) = "") Then Exit For
Next Shp

End Sub
0 голосов
/ 01 июля 2019

Спасибо, ребята, за вашу помощь!Мне удалось решить эту проблему с помощью следующего кода: 

  Sub CropToFit()

ActivePresentation.Slides(1).Shapes.AddPicture FileName:="U:\xyz\EAP.png", _LinkToFile:=msoTrue
ActivePresentation.Slides(1).Shapes.AddPicture FileName:="U:\xyz\DAP_01.png",    LinkToFile:=msoTrue, _

    ActivePresentation.SlideShowWindow.view.Exit


Do Events

Dim osld As Slide
Dim oshp As Shape

On Error Resume Next

Set osld = ActiveWindow.view.Slide

If Not osld Is Nothing Then
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderPicture Then
oshp.Select
CommandBars.ExecuteMso ("PictureFitCrop")

End If 'picture placeholder
End If 'placehoder
Next oshp
End If ' Slide selected

End Sub
...