Eu tenho um slide que é atualizado diariamente com imagens, e elas geralmente são adicionadas incorretamente pelos outros usuários. Isso significa que tenho que redimensionar, reposicionar e adicionar um esboço para atender ao padrão definido para essas apresentações.
Eu encontrei uma macro que me permite redimensionar todas as imagens com base em uma seleção
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
Funciona perfeitamente, mas alguém sabe se algo pode ser adicionado a isso para que as imagens fiquem em uma horizontal de 19cm e uma vertical de 4cm?
Tags microsoft-powerpoint