У меня есть слайд, который ежедневно обновляется с изображениями, и обычно все они неправильно добавляются другими пользователями. Это означает, что мне нужно изменить размер, изменить положение и добавить схему, чтобы соответствовать определенному стандарту для этих презентаций.
Я нашел макрос, который позволяет мне изменить размер всех изображений на основе выбора
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 см?