Excel VBA如何判断形状TextFrame的文本是否溢出

Excel的对象模型中，TextFrame和TextFrame2对象均未提供Word VBA里的Overflowing属性，直接照搬Word的代码必然触发"对象不支持该属性或方法"报错。另外注意Excel里形状归属于工作表对象，不存在Word里ActiveDocument.Shapes的调用写法。

方案1：文本边界对比法（推荐，无闪动、兼容Excel 2010及以上版本） #

核心逻辑是对比文本框扣除内边距后的可用高度，和文本实际渲染的总高度，文本渲染高度大于可用高度即判定为溢出，判断精度高，执行无感知。

' 判定目标形状文本框是否存在文本溢出
' 参数：带文本框的形状对象（文本框、矩形标注、艺术字等均可）
' 返回：True=溢出，False=未溢出
Function IsTextOverflow(targetShape As Shape) As Boolean
    Dim tf2 As TextFrame2
    Dim availableHeight As Single
    Dim textRenderHeight As Single
    
    ' 无文本框的形状直接返回未溢出
    If Not targetShape.HasTextFrame Then
        IsTextOverflow = False
        Exit Function
    End If
    
    Set tf2 = targetShape.TextFrame2
    ' 空文本、开启自动适配的场景不存在溢出
    If tf2.TextRange.Text = "" Then
        IsTextOverflow = False
        Exit Function
    End If
    If tf2.AutoSize <> msoAutoSizeNone Then
        IsTextOverflow = False
        Exit Function
    End If
    
    ' 计算扣除上下内边距后的实际可排版高度
    availableHeight = targetShape.Height - tf2.MarginTop - tf2.MarginBottom
    ' 获取文本实际渲染占用的高度
    textRenderHeight = tf2.TextRange.BoundHeight
    
    ' 加0.5磅容错值，规避浮点计算误差导致的误判
    IsTextOverflow = (textRenderHeight > availableHeight + 0.5)
End Function

调用示例：

Sub CheckDemo()
    Dim myTBox As Shape
    ' 注意指定形状所在的工作表，不要照搬Word的ActiveDocument写法
    Set myTBox = ActiveSheet.Shapes("MyTextBox")
    If IsTextOverflow(myTBox) Then
        ' 此处写溢出后的处理逻辑，例如放大形状、缩小字号、提示用户等
        MsgBox "文本框内容已溢出！"
    End If
End Sub

如果需要判断横向（单行无换行场景）的溢出，可额外增加宽度对比逻辑，用tf2.TextRange.BoundWidth和「形状宽度 - 左边距 - 右边距」做对比即可。

方案2：临时自动适配测高法（兼容Excel 2007及更早版本） #

旧版Excel对TextFrame2的支持不完善，可以临时开启形状的自动适配大小属性，记录适配后的形状高度，和原始高度对比判断溢出，缺点是执行时会有极轻微的形状闪动。

Function IsTextOverflowLegacy(targetShape As Shape) As Boolean
    Dim tf As TextFrame
    Dim originalH As Single
    Dim fitH As Single
    
    If Not targetShape.HasTextFrame Then
        IsTextOverflowLegacy = False
        Exit Function
    End If
    Set tf = targetShape.TextFrame
    If tf.Characters.Text = "" Then
        IsTextOverflowLegacy = False
        Exit Function
    End If
    
    originalH = targetShape.Height
    ' 临时开启自动适配
    tf.AutoSize = True
    fitH = targetShape.Height
    ' 还原原始大小和设置
    tf.AutoSize = False
    targetShape.Height = originalH
    
    IsTextOverflowLegacy = (fitH > originalH + 0.5)
End Function

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