1

У меня есть слайд, который ежедневно обновляется с изображениями, и обычно все они неправильно добавляются другими пользователями. Это означает, что мне нужно изменить размер, изменить положение и добавить схему, чтобы соответствовать определенному стандарту для этих презентаций.

Я нашел макрос, который позволяет мне изменить размер всех изображений на основе выбора

Sub Imagesize
Dim oshp As Shape
Dim oPic As Shape
Dim picH As Single
Dim picW As Single
Dim osld As Slide
If ActiveWindow.Selection.Type = ppSelectionNone Then GoTo err
If ActiveWindow.Selection.ShapeRange.Count <> 1 Then GoTo err
Set oshp = ActiveWindow.Selection.ShapeRange(1)

For Each osld In ActivePresentation.Slides
For Each oPic In osld.Shapes

If oPic.Type = msoPicture Then
picW = oPic.Width
picH = oPic.Height
oPic.LockAspectRatio = True
oPic.Width = oshp.Width
oPic.Left = oPic.Left - (oshp.Width - picW) / 2
oPic.Top = oPic.Top - (oshp.Height - picH) / 2
End If

If oPic.Type = msoPlaceholder Then
If oPic.PlaceholderFormat.ContainedType = msoPicture Then
picW = oPic.Width
picH = oPic.Height
oPic.LockAspectRatio = True
oPic.Width = oshp.Width
oPic.Left = oPic.Left - (oshp.Width - picW) / 2
oPic.Top = oPic.Top - (oshp.Height - picH) / 2
End If
End If

Next oPic
Next osld
Exit Sub
err:
MsgBox "Please select ONE shape and retry!", vbCritical
End Sub

Он отлично работает, но кто-нибудь знает, можно ли добавить к этому что-нибудь, чтобы изображения располагались на горизонтальной плоскости 19 см и вертикальной 4 см?

0