如何使用VBA调整PowerPoint各幻灯片内指定单张图片尺寸与位置

你之前的代码存在两个直接导致运行异常的错误：

• 循环嵌套顺序完全写反：内层遍历形状的循环未正常闭合，先执行了Next sld再执行Next shp，属于基础语法结构错误。添加On Error Resume Next后错误被强制忽略，循环逻辑乱序执行，才会出现所有图片被误调整的问题。
• 匹配逻辑不够严谨：仅靠形状名称判断，遇到占位符名称不一致、同名非图片形状时会出现漏改、误改。

Sub resizeImage()
    Dim sld As Slide
    Dim shp As Shape
    Dim processedCount As Long
    Dim missingSlideList As String
    
    processedCount = 0
    missingSlideList = ""
    
    ' 遍历所有幻灯片
    For Each sld In ActivePresentation.Slides
        Dim found As Boolean
        found = False
        ' 遍历当前幻灯片所有形状
        For Each shp In sld.Shapes
            ' 同时匹配形状名称+是否包含图片，避免误改其他同名形状
            If shp.Name = "Content Placeholder 2" And shp.HasImage Then
                With shp
                    ' 不需要保持纵横比就留msoFalse，需要保持原比例就改成msoTrue
                    .LockAspectRatio = msoFalse
                    .Height = 400
                    .Width = 300
                    .Left = 45
                    .Top = 45
                End With
                processedCount = processedCount + 1
                found = True
                Exit For ' 找到目标后跳出当前页形状循环，提升运行效率
            End If
        Next shp ' 内层形状循环优先闭合
        If Not found Then
            missingSlideList = missingSlideList & "第" & sld.SlideIndex & "页、"
        End If
    Next sld ' 外层幻灯片循环最后闭合
    
    ' 弹出执行结果
    MsgBox "处理完成，共调整" & processedCount & "张图片", vbInformation
    If missingSlideList <> "" Then
        MsgBox "以下幻灯片未找到名为Content Placeholder 2的图片：" & vbCrLf & Left(missingSlideList, Len(missingSlideList) - 1), vbExclamation
    End If
End Sub

• 代码默认单位为磅，如果需要使用厘米作为尺寸单位，按1厘米≈28.35磅的比例换算数值即可。
• 运行结束后会自动统计未匹配到目标图片的幻灯片页码，你可以根据提示打开对应页面，按Alt+F10调出选择窗格查看形状真实名称，对应修改代码里的名称匹配字符串即可。
• 禁止在代码开头添加全局On Error Resume Next，这类写法会屏蔽所有语法、逻辑错误，极易造成不可预期的文件改动。如果确实需要针对单行代码做容错，要在该行执行后立刻添加On Error GoTo 0恢复正常错误捕获。

内容的提问来源于stack exchange，提问作者Kenrick Channata