点击另一ContentControl时ContentControlOnExit事件崩溃问题求助

问题场景 #

• 开发Word自动化宏，文档包含6个评估项，用户需在标记为CritèreX（X为1-6）的Occurrences内容控件输入1-10的出现次数
• 退出该控件时触发ContentControlOnExit事件，执行4个过程：selectComment、occuCount、addBorders、tableFill
• 点击文档空白处、普通文本或静态图片退出时所有过程正常；但点击对应编号的Image内容控件时，仅addBorders过程崩溃导致文档关闭，其余3个过程运行正常
• addBorders功能：根据输入次数给对应Image内容控件加边框——次数<4加绿色边框，≥4加红色边框

原代码片段 #

Document_ContentControlOnExit事件 #

Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)
    Dim i As Integer
    ' 注意：原声明仅ccTT_NV为Integer，其余为Variant，建议修正为显式类型
    Dim ccNb As Integer, ccIndice As Integer, ccTT_V As Integer, ccTT_NV As Integer
    Dim ccCritRisk As String

    ' 处理评估项出现次数修改
    If Left(CC.Tag, 7) = "Critère" Then
        CC.SetPlaceholderText , , "Occurences"
        ccIndice = CInt(Right(CC.Tag, 1)) ' 获取评估项索引
        
        If Not CC.ShowingPlaceholderText Then ' 已输入内容
            ccNb = CInt(CC.Range.Text) ' 获取出现次数
            
            selectComment ccNb, ccIndice, critArray ' 正常运行
            occuCount ' 正常运行
            addBorders ccNb, ccIndice ' 点击Image控件时崩溃
            tableFill ccNb, ccIndice ' 正常运行
         Else
            With ActiveDocument.SelectContentControlsByTitle("Com" & CStr(ccIndice))(1)
                .SetPlaceholderText , , "Commentaire automatique"
                .Range.Text = .PlaceholderText ' 原代码PlaceholderText未定义，修正为控件自身的占位符文本
            End With
         End If
    Else
        ' 其他内容控件处理逻辑（与问题无关）
    End If
End Sub

addBorders过程 #

Sub addBorders(ccNb, ccIndice)
    If ccNb > 10 Then
        MsgBox ("Le nombre " & ccNb & " est trop élevé")
        Exit Sub
    Else
        If ccNb < 4 Then
            With ActiveDocument.SelectContentControlsByTitle("Image" & CStr(ccIndice))(1).Range
                With .Borders(wdBorderLeft)
                        .LineStyle = wdLineStyleSingle
                        .LineWidth = wdLineWidth300pt
                        .Color = RGB(71, 212, 89)
                End With
            End With
        Else ' 添加红色边框
            With ActiveDocument.SelectContentControlsByTitle("Image" & CStr(ccIndice))(1).Range
                With .Borders(wdBorderLeft)
                        .LineStyle = wdLineStyleSingle
                        .LineWidth = wdLineWidth300pt
                        .Color = RGB(200, 0, 0)
                End With
            End With
        End If
    End If
End Sub

问题根源 #

崩溃原因是在ContentControlOnExit事件触发期间，Word的控件焦点正处于从Occurrences控件切换到Image控件的过程中，此时直接操作Image控件的Range对象会引发对象状态冲突——目标Image控件正被用户选中，其Range处于锁定或不稳定状态，修改边框会触发Word内部错误。

可行解决方案 #

方案1：延迟执行边框修改（推荐） #

利用Application.OnTime延迟0.1秒执行边框修改，让控件焦点完全切换完成后再操作，避免状态冲突：

1. 替换原事件中调用addBorders的代码：

' 延迟0.1秒执行，确保焦点切换完成
Application.OnTime Now + TimeValue("00:00:00.1"), "'addBordersDelayed " & ccNb & ", " & ccIndice & "'"

2. 新增延迟执行的过程：

Sub addBordersDelayed(ccNb As Integer, ccIndice As Integer)
    Dim targetCC As ContentControl
    ' 先检查目标控件是否存在，避免报错
    On Error Resume Next
    Set targetCC = ActiveDocument.SelectContentControlsByTitle("Image" & CStr(ccIndice))(1)
    On Error GoTo 0
    
    If targetCC Is Nothing Then Exit Sub
    
    If ccNb > 10 Then
        MsgBox "Le nombre " & ccNb & " est trop élevé"
        Exit Sub
    End If
    
    ' 统一处理边框样式，简化代码
    With targetCC.Range.Borders(wdBorderLeft)
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth300pt
        .Color = IIf(ccNb < 4, RGB(71, 212, 89), RGB(200, 0, 0))
    End With
End Sub

方案2：操作前临时转移光标 #

在addBorders开头添加代码，将光标移到文档空白处，解除目标控件的选中状态：

Sub addBorders(ccNb As Integer, ccIndice As Integer)
    ' 临时将光标移到文档开头，避免操作选中的控件
    ActiveDocument.Range(0, 0).Select
    
    ' 后续原逻辑不变...
    If ccNb > 10 Then
        MsgBox "Le nombre " & ccNb & " est trop élevé"
        Exit Sub
    End If
    
    With ActiveDocument.SelectContentControlsByTitle("Image" & CStr(ccIndice))(1).Range.Borders(wdBorderLeft)
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth300pt
        .Color = IIf(ccNb < 4, RGB(71, 212, 89), RGB(200, 0, 0))
    End With
End Sub

方案3：直接操作Image控件内的Shape对象 #

如果Image内容控件中嵌入的是Shape类型的图片，可直接操作Shape的边框，绕过Range对象的状态问题：

Sub addBorders(ccNb As Integer, ccIndice As Integer)
    Dim targetCC As ContentControl
    Dim imgShape As Shape
    
    On Error Resume Next
    Set targetCC = ActiveDocument.SelectContentControlsByTitle("Image" & CStr(ccIndice))(1)
    Set imgShape = targetCC.Range.ShapeRange(1)
    On Error GoTo 0
    
    If targetCC Is Nothing Or imgShape Is Nothing Then Exit Sub
    
    If ccNb > 10 Then
        MsgBox "Le nombre " & ccNb & " est trop élevé"
        Exit Sub
    End If
    
    ' 修改Shape的边框样式
    With imgShape.Line
        .Style = msoLineSingle
        .Weight = 3 ' 对应wdLineWidth300pt的宽度
        .ForeColor.RGB = IIf(ccNb < 4, RGB(71, 212, 89), RGB(200, 0, 0))
    End With
End Sub

额外优化建议 #

• 原代码中变量声明不规范，需显式指定所有变量的类型（如Dim ccNb As Integer），避免Variant类型带来的隐式转换错误
• 操作内容控件前添加错误处理（On Error Resume Next + 检查对象是否存在），避免因控件不存在导致的崩溃

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