如何实现Word富文本内容控件未填写时禁止保存文档？现有VBA代码故障排查求助

你的代码之所以没效果，是因为踩了几个Word VBA的常见坑，咱们一步步修正：

1. 用错了事件（最关键的错误） #

你写的Workbook_BeforeSave是Excel的工作簿保存事件，Word里对应的文档保存前事件是Document_BeforeSave，而且这个事件必须写在Word的ThisDocument模块里（打开VBA编辑器后，在左侧项目窗格找到你的文档下的ThisDocument，双击进入写代码，这就是你说的“嵌入在Word文档中”的位置）。

2. 没有正确获取到富文本控件 #

原代码只是声明了控件变量，但根本没定位到文档里实际的控件，变量是空的，自然没法判断内容。你需要通过控件的Title或Tag属性来找到它（这两个属性可以在Word的“开发工具”选项卡中设置内容控件时配置）。

3. 空值判断和消息框逻辑错误 #

RichTextContentControl的Value是Range对象，直接判断= ""不准确；而且你用vbInformation判断消息框返回值是错的——vbInformation是消息框的图标类型，用户点击确定的返回值是vbOK，其实这里不管用户点什么，只要没填就应该取消保存。

修正后的完整代码 #

把这段代码复制到ThisDocument模块里，记得替换CONTROL_TITLE的值为你实际的富文本控件的Title：

Private Sub Document_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim targetControl As RichTextContentControl
    ' 替换成你的富文本控件的Title（或Tag，根据需求改查找方式）
    Const CONTROL_TITLE As String = "Approval ID"
    
    ' 尝试通过Title定位控件（如果用Tag，就换成下面的注释代码）
    On Error Resume Next ' 防止找不到控件时报错
    Set targetControl = Me.ContentControls.Item(CONTROL_TITLE)
    ' 如果用Tag查找：Set targetControl = Me.ContentControls.SelectByTag("ApprovalIDTag").Item(1)
    On Error GoTo 0
    
    ' 检查控件是否存在
    If targetControl Is Nothing Then
        MsgBox "未找到指定的富文本内容控件，请检查控件的Title/Tag设置。", vbExclamation
        Cancel = True
        Exit Sub
    End If
    
    ' 检查控件内容是否为空（去除前后空格后判断）
    If Trim(targetControl.Range.Text) = "" Then
        MsgBox "请填写Approval ID字段，文件无法保存。", vbInformation
        Cancel = True ' 取消保存操作
    End If
End Sub

关键注意事项 #

• 保存文档为启用宏的格式（.docm），否则宏会被禁用，事件不会触发。
• 确保控件的Title或Tag和代码里的字符串完全一致（区分大小写）。
• 如果需要检查多个富文本控件，只需复制判断逻辑，逐个检查每个控件的内容即可。
• 测试时，尝试空着控件点保存，应该会弹出提示并阻止保存；填写后就能正常保存了。

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