PPT填空题宏触发Run-time error -2147188160，请求协助排查

核心错误原因 #

你遇到的Run-time error '-2147188160'是因为代码依赖SlideShowWindow对象，但当前演示文稿没有处于幻灯片放映状态——这个对象仅在幻灯片放映时才会存在。除此之外，你的代码还有几处逻辑问题需要修正。

代码中的其他问题 #

• 定义了变量CurrentSlideNo，但后续错误使用了未声明的CurrentSlide
• 单独执行UCase()语句却没有赋值给变量，这部分代码完全无效
• Fill.ForeColor.RGB没有指定具体是哪个形状的填充属性，VBA无法识别目标对象
• 未检查OLEFormat.Object是否存在，如果AA不是OLE控件（比如文本框）会触发额外错误
• 获取正确答案时缺少.Text属性，应该是TextFrame.TextRange.Text

修复后的完整代码 #

Sub ReplaceColor()
    Dim CurrentSlide As Slide
    Dim lReplaceColor As Long
    Dim lFindColor As Long
    Dim userAnswer As String
    Dim correctAnswer As String
    Dim targetShape As Shape
    
    ' 检查是否处于幻灯片放映模式
    If ActivePresentation.SlideShowWindows.Count = 0 Then
        MsgBox "请先启动幻灯片放映模式再执行宏！", vbExclamation
        Exit Sub
    End If
    
    Set CurrentSlide = ActivePresentation.SlideShowWindow.View.Slide
    lReplaceColor = RGB(0, 255, 0) ' 正确答案填充绿色
    lFindColor = RGB(255, 0, 0) ' 错误答案填充红色
    
    ' 定位要修改填充颜色的形状（这里默认是AA，可根据需求调整）
    On Error Resume Next
    Set targetShape = CurrentSlide.Shapes("AA")
    On Error GoTo 0
    
    If targetShape Is Nothing Then
        MsgBox "未找到名为AA的形状！", vbCritical
        Exit Sub
    End If
    
    ' 获取并统一转换为大写，避免大小写干扰判断
    userAnswer = UCase(CurrentSlide.Shapes("AA").OLEFormat.Object.Value)
    correctAnswer = UCase(CurrentSlide.Shapes("CA").TextFrame.TextRange.Text)
    
    ' 判断答案并设置填充色
    If userAnswer = correctAnswer Then
        targetShape.Fill.ForeColor.RGB = lReplaceColor
        ActivePresentation.SlideShowWindow.View.Next ' 正确则跳转到下一页
    Else
        targetShape.Fill.ForeColor.RGB = lFindColor
    End If
End Sub

关键优化说明 #

• 增加放映模式检查，提前拦截错误并给出提示
• 修正变量名不一致问题，直接使用Slide对象而非索引，更安全
• 将UCase处理后的文本存入变量，用于后续比较判断
• 明确指定填充颜色的目标形状，避免VBA找不到操作对象
• 增加形状存在性检查，防止因形状名称错误导致崩溃
• 补充Text属性，确保正确获取文本框内容

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