PPT宏代码

以下代码适用于：当每张幻灯片由一张图制作，快速统一图片格式。

1、将所有ppt中所有幻灯片中的图更改为宽度34cm，固定纵横比

Sub ResizeAllPictures()Dim sld As SlideDim shp As ShapeDim targetWidth As SingleDim aspectRatio As Single' 设置目标宽度为34厘米' 1厘米 = 28.34646磅 (Points)，这是PowerPoint内部单位targetWidth = 34 * 28.34646' 遍历所有幻灯片For Each sld In ActivePresentation.Slides' 遍历幻灯片中的所有形状For Each shp In sld.Shapes' 判断形状是否为图片If shp.Type = msoPicture Then' 计算当前图片的宽高比aspectRatio = shp.Height / shp.Width' 设置宽度为34厘米（转换为磅值）shp.Width = targetWidth' 根据原始宽高比设置高度shp.Height = targetWidth * aspectRatioEnd IfNext shpNext sldMsgBox "已将所有图片宽度设置为34厘米，并保持纵横比！", vbInformation, "操作完成"
End Sub

2、将ppt所有幻灯片中的图片使用代码一键上下居中、左右居中

Sub CenterAllPicturesEnhanced()Dim sld As SlideDim shp As ShapeDim slideWidth As SingleDim slideHeight As SingleDim picCount As IntegerDim originalAspectRatio As BooleanOn Error GoTo ErrorHandlerpicCount = 0' 遍历所有幻灯片For Each sld In ActivePresentation.SlidesslideWidth = sld.Master.WidthslideHeight = sld.Master.Height' 遍历幻灯片中的所有形状For Each shp In sld.Shapes' 检查形状是否为图片且可见If shp.Type = msoPicture And shp.Visible Then' 保存原始纵横比设置originalAspectRatio = shp.LockAspectRatio' 确保纵横比锁定，防止图片变形shp.LockAspectRatio = msoTrue' 计算居中位置:cite[1]shp.Left = (slideWidth - shp.Width) / 2shp.Top = (slideHeight - shp.Height) / 2' 恢复原始纵横比设置shp.LockAspectRatio = originalAspectRatiopicCount = picCount + 1End IfNext shpNext sldIf picCount > 0 ThenMsgBox "成功将 " & picCount & " 张图片在各自幻灯片中居中对齐。", vbInformation, "操作完成"ElseMsgBox "未在演示文稿中找到任何图片。", vbExclamation, "提示"End IfExit SubErrorHandler:MsgBox "发生错误：" & Err.Description, vbCritical, "错误"
End Sub