Word 365 VBA：下拉内容控件选值后插入带内容控件表格报错解决

问题描述 #

我需要实现：当下拉内容控件（标签为ReturnType）选择不同选项后，在文档第3段位置插入对应结构的表格（部分表格包含内容控件）。当前遇到的异常：

• 用鼠标点击非内容控件区域退出下拉控件时，代码可正常生成表格
• 用Tab键切换到下一个内容控件时，触发Run-time error '4605'，提示：This method or property is not available because the current selection partially covers a plain text content control

测试代码如下：

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    
    If ContentControl.Tag = "ReturnType" Then
        
        Dim tbl As Table
        Dim rng As Range
        
        Select Case ContentControl.Range.Text
            Case "Selection 1"
                Set rng = ActiveDocument.Content.Paragraphs(3).Range
                Set tbl = rng.Tables.Add(rng, 3, 3)
                    tbl.cell(1, 2).Range.ContentControls.Add wdContentControlCheckBox
            Case "Selection 2"
                Set rng = ActiveDocument.Content.Paragraphs(3).Range
                Set tbl = rng.Tables.Add(rng, 2, 2)
            Case "Selection 3"
                Set rng = ActiveDocument.Content.Paragraphs(3).Range
                Set tbl = rng.Tables.Add(rng, 1, 1)
        End Select
    End If
End Sub

已尝试多分支If语句、Select Case、独立子过程生成表格等写法，问题未解决。

问题原因 #

Tab键退出下拉控件时，Word正自动将焦点切换到下一个内容控件，此时当前Selection处于“半覆盖内容控件”的状态，插入表格并添加内容控件的操作会与焦点切换流程冲突，触发4605错误。

修复方案 #

通过禁用屏幕更新、清理旧表格、锁定操作范围三个核心步骤解决冲突：

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    ' 仅处理目标下拉控件
    If ContentControl.Tag <> "ReturnType" Then Exit Sub
    
    Dim targetPara As Paragraph
    Dim rng As Range
    Dim existingTbl As Table
    
    ' 禁用屏幕更新，避免UI操作干扰焦点切换
    Application.ScreenUpdating = False
    
    Set targetPara = ActiveDocument.Content.Paragraphs(3)
    Set rng = targetPara.Range
    
    ' 先删除目标段落中已存在的表格（避免重复插入导致布局混乱）
    On Error Resume Next
    Set existingTbl = rng.Tables(1)
    If Not existingTbl Is Nothing Then existingTbl.Delete
    On Error GoTo 0
    
    ' 调整Range到段落末尾，避免与内容控件范围重叠
    rng.Collapse wdCollapseEnd
    rng.MoveStart wdCharacter, -1
    
    Select Case ContentControl.Range.Text
        Case "Selection 1"
            Dim tbl1 As Table
            Set tbl1 = rng.Tables.Add(rng, 3, 3)
            tbl1.Cell(1, 2).Range.ContentControls.Add wdContentControlCheckBox
        Case "Selection 2"
            rng.Tables.Add rng, 2, 2
        Case "Selection 3"
            rng.Tables.Add rng, 1, 1
    End Select
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

额外优化建议 #

• 若文档需要保护，建议在表格插入完成后再启用文档保护，避免保护状态下操作内容控件出错
• 可给下拉控件添加ContentControlOnEnter事件，提前清除旧表格，避免重复触发生成逻辑
• 若仍存在焦点问题，可在代码末尾添加ActiveDocument.Range(0, 0).Select强制重置焦点

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