PowerPoint VBA宏：实现仅将选中矩形置于底层的问题

你的代码问题出在每次操作的是整个选中的形状范围，而非单个形状。当同时选中矩形和图片时，循环会先把所有选中形状置底，接着又把所有选中形状置顶，最终效果互相抵消，所以看起来没有作用。

修正后的代码如下，直接针对循环里的单个形状调整层级：

Sub 矩形置底图片置顶()
    Dim oSh As Shape
    
    ' 遍历选中的每个形状
    For Each oSh In ActiveWindow.Selection.ShapeRange
        If oSh.Type <> msoPicture Then
            ' 非图片形状（比如矩形）置底
            oSh.ZOrder msoSendToBack
        Else
            ' 图片形状置顶
            oSh.ZOrder msoBringToFront
        End If
    Next oSh
End Sub

关键修改点： #

• 把ActiveWindow.Selection.ShapeRange.ZOrder改成oSh.ZOrder，确保每次只调整当前循环到的单个形状
• 简化判断逻辑，非图片直接置底，图片直接置顶，无需多余的ElseIf分支

使用说明： #

1. 打开PowerPoint，按Alt + F11打开VBA编辑器
2. 右键左侧项目窗格的PPT文件，选择「插入」→「模块」
3. 将上述代码粘贴到模块中
4. 返回PPT界面，选中需要调整的矩形和图片，按Alt + F8调用该宏执行

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