如何把PPT里的所有图片全设置成一样大小
请确保图像以 Shape 的形式插入,并且没有其他因素导致大小无法调整。
Sub SetPicturesSize()
Dim slide As Slide
Dim shape As Shape
Dim pic As Shape
Dim width As Single
Dim height As Single
' 设置目标大小(以磅为单位)
width = 200
height = 200
' 循环遍历每个幻灯片
For Each slide In ActivePresentation.Slides
' 循环遍历每个形状
For Each shape In slide.Shapes
' 检查形状是否为图片
If shape.Type = msoPicture Then
Set pic = shape
' 设置图片大小
pic.LockAspectRatio = msoFalse ' 可以调整纵横比
pic.Width = width
pic.Height = height
ElseIf shape.Type = msoGroup Then
' 如果形状是组合形状,则遍历组合形状中的每个形状
For Each subShape In shape.GroupItems
' 检查形状是否为图片
If subShape.Type = msoPicture Then
Set pic = subShape
' 设置图片大小
pic.LockAspectRatio = msoFalse ' 可以调整纵横比
pic.Width = width
pic.Height = height
End If
Next subShape
End If
Next shape
Next slide
End Sub