检查范围是否适合单行

Question

我正在以编程方式填写一个受规制的表格模板，其中预定义了行（作为表格单元格）： _{（使用纯文本内容控件作为占位符，但这与当前问题无关。）}

因此，我必须手动将长文本分成多行（自动添加行或其他操作不是选项，因为分页符也是预定义的。）

现在，由于字符具有不同的宽度，我不能仅设置一些硬编码字符限制来突破（或者，我可以，并且这就是我现在正在做的，但是事实证明，这是效率低下且不可靠的） ）。所以：

如何检查文本范围是否适合单行-如果不适合，则适合多少行？

我已经签出Range Members (Word)，但看不到任何相关内容。

Answer 1

唯一的方法是.Select文本，它们操纵选择。 Selection是唯一可以使用wdLine作为边界的对象。 Word对象模型中的其他所有内容都无法使用自动换行符。

Sub GetFirstLineOfRange(RangeToCheck As Range, FirstLineRange As Range)

  'Otherwise, Word doesn't always insert automatic line breaks
  'and all the text will programmatically look like it's on a single line
  If Not Application.Visible Or Not Application.ScreenUpdating Then
    Application.ScreenRefresh
  End If

  Dim SelectionRange As Range

  Set SelectionRange = Selection.Range
  Set FirstLineRange = RangeToCheck

  FirstLineRange.Select
  Selection.Collapse Direction:=wdCollapseStart
  Selection.EndOf Unit:=wdLine, Extend:=wdExtend

  Set FirstLineRange = Selection.Range
  If FirstLineRange.End > RangeToCheck.End Then
    FirstLineRange.End = RangeToCheck.End
  End If

  SelectionRange.Select

End Sub

Function IsRangeOnOneLine(RangeToCheck As Range) As Boolean

  Dim FirstLineRange As Range

  GetFirstLineOfRange RangeToCheck, FirstLineRange
  IsRangeOnOneLine = FirstLineRange.End >= RangeToCheck.End

End Function

子例程GetFirstLineOfRange接受RangeToCheck并将FirstLineRange设置为给定范围内的第一行文本。

函数IsRangeOnOneLine接受RangeToCheck并返回True（如果范围适合一行文本），否则返回False。该函数的工作方式是获取给定范围内的第一行文本，并检查其是否包含该范围。

需要Selection中的GetFirstLineOfRange的操作，因为子例程要将范围的末尾移动到行的末尾，并且移动单位wdLine仅可用与Selection。该子例程保存并恢复当前的Selection；如果不需要这样做，则可以删除临时变量SelectionRange和关联的语句。

注意：

Answer 2

无需滚动任何内容-无论如何都不可靠。尝试根据以下方法进行尝试：

With Selection
  If .Characters.First.Information(wdVerticalPositionRelativeToPage) = _
  .Characters.Last.Information(wdVerticalPositionRelativeToPage) Then
    MsgBox .Text & vbCr & vbCr & "Spans one line or less."
  Else
    MsgBox .Text & vbCr & vbCr & "Spans more than one line."
  End If
End With