Word VBA隐藏含文本框、组合形状内未高亮文本的问题求助

原有代码的问题 #

• 遍历Shape对象时，Find方法的作用范围始终是ActiveDocument.Content（主文档正文），从未实际访问文本框内部的文本内容，所以文本框部分不会生效
• 处于组合状态的Shape属于msoGroup类型，不会被直接识别为msoTextBox，也无法直接访问内部的子文本框，需要递归拆解组合对象遍历子元素

可行实现思路 #

你可以通过递归遍历所有形状（含组合内子形状）+ 单独处理每个文本框的文本范围实现需求，完整代码如下：

Sub Hide_Unhighlighted_All()
    ' 先处理主文档正文的未高亮文本
    HideUnhighlightedInRange ActiveDocument.Content
    
    ' 遍历所有形状，含组合内的子形状
    ProcessShapes ActiveDocument.Shapes
    
    ' 可选：如果需要覆盖页眉页脚、批注等其他区域的文本框，可放开下方注释
    ' Dim rngStory As Range
    ' For Each rngStory In ActiveDocument.StoryRanges
    '    HideUnhighlightedInRange rngStory
    '    ProcessShapes rngStory.ShapeRange
    ' Next
End Sub

' 处理指定形状集合，支持递归拆解组合
Sub ProcessShapes(shpCollection As Object)
    Dim shp As Shape
    For Each shp In shpCollection
        Select Case shp.Type
            Case msoTextBox
                ' 文本框直接处理内部文本
                If shp.TextFrame.HasText Then
                    HideUnhighlightedInRange shp.TextFrame.TextRange
                End If
            Case msoGroup
                ' 组合形状递归处理子元素
                ProcessShapes shp.GroupItems
        End Select
    Next shp
End Sub

' 隐藏指定范围内所有未高亮的文本
Sub HideUnhighlightedInRange(targetRng As Range)
    With targetRng.Find
        .ClearFormatting
        .Format = True
        .Highlight = False
        .Text = ""
        .Replacement.ClearFormatting
        .Replacement.Font.Hidden = True
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
    End With
End Sub

代码说明 #

• 把「隐藏指定范围内未高亮文本」的逻辑抽象为独立的HideUnhighlightedInRange方法，可复用在正文、文本框、页眉页脚等任意Range对象上
• ProcessShapes方法通过递归自动处理组合内的子形状，不需要手动拆解文档里的现有组合

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