代码之家 › 专栏 › 技术社区 › ivan_pozdeev RenanSS

检查一个范围是否适合一条直线

word-vba ms-word vba

ivan_pozdeev RenanSS · 技术社区 · 6 年前

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

因此,我必须手动将长文本拆分成行(自动添加行或其他内容不是一个选项,因为分页符也是预定义的)。

现在,由于字符有不同的宽度,我不能只设置一些硬编码字符限制来突破(或者说,我可以,这就是我现在所做的,但事实证明,这是低效和不可靠的,正如预期的那样)。所以:

如何检查一个文本范围是否适合一行,如果不适合,应该检查多少?

我已经退房了 Range Members (Word) 但看不到任何相关信息。

2 回复 | 直到 6 年前

ivan_pozdeev RenanSS 6 年前

唯一的办法就是 .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 拿一个 范围检查 和回报 True 如果范围适合一行文本,并且 False 否则。该函数通过获取给定范围内的第一个文本行并检查它是否包含该范围来工作。

操纵 选择 在里面 获取第一行范围 是必需的,因为子程序希望将范围的末端移动到行的末端,并且移动单元 WDLINE公司 只有在 选择 是的。子程序保存并恢复当前 选择 ;如果不需要,则临时变量 SelectionRange 并且可以删除关联的语句。

注:

macropod 6 年前

不需要滚动任何东西-这在任何情况下都是不可靠的。尝试一些基于:

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