Word VBA添加行选择的长度

Question

我想写一个Word VBA宏，它插入一个垂直线所选文本的长度。

apos = Int(Selection.Information(6)) 
Set aLine = ActiveDocument.Shapes.AddLine(26, apos, 26, apos + 40) 
aLine.Select 
With Selection 
    .ShapeRange.Line.Weight = 3# 
    .ShapeRange.Line.Visible = msoTrue 
    .ShapeRange.Line.Style = msoLineSingle 
    .ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0) 
End With 

但是，代码将“40”的垂直线长度 如何调整长度“40”是所选文本的长度是多少？ 谢谢

Answer 1

使用完全相同的方法确定行的开始。结尾位于Selection + 1中最后一个字符的Information(wdHorizontalPositionRelativeToPage)处。以下是完整的代码。

Private Sub LineUnderSelection() 
    ' 08 May 2017 

    Dim Rng As Range 
    Dim FontHeight As Single, ParaSpace As Single 
    Dim LineStart As Single, LineEnd As Single 

    With Selection 
     With .Range 
      Do While Asc(.Text) < 48 
       ' remove excluded characters at start 
       .MoveEnd wdCharacter, 1 
      Loop 
      Do While Asc(Right(.Text, 1)) < 48 
       ' remove excluded characters at end 
       .MoveEnd wdCharacter, -1 
      Loop 
      LineStart = .Information(wdHorizontalPositionRelativeToPage) 
      Set Rng = Selection.Range 
      Rng.SetRange .End, .End 
      FontHeight = Int(Rng.Font.Size) 
      ParaSpace = 2 - Rng.Paragraphs(1).SpaceBefore 
      If ParaSpace < -3 Then ParaSpace = -3 
      LineEnd = Rng.Information(wdHorizontalPositionRelativeToPage) 
      SetLine ActiveDocument, "Underscore", LineStart, LineEnd - LineStart, _ 
        .Information(wdVerticalPositionRelativeToPage) _ 
         + FontHeight + ParaSpace, 1.5, vbRed 
     End With 
    End With 
End Sub 

正如你所看到的，我发现额外的字符是不需要的。 Word将该行自动扩展到该字符的末尾。在发现这一点的过程中，我也发现Word不喜欢强调退货。因此，该代码排除了所有ASCII码小于48的字符（代表字符1）。然后，我将相同的规则应用于主角，同样将其从选择中移除。如果这足够或太多，请运行您自己的测试。有很多字符代码> 128，这可能是令人反感的。

该代码取最后一个字符的大小并将其高度添加到垂直位置。这是将行放在选定的文本下方，而不是上面。我增加了2分以保持文本和行之间的空间。

单词注意之前的空间。您的选择可能包含几个段落。我的代码仅查看最后一个字符是其成员的段落。如果段落格式中有SpaceBefore，Word似乎将该行降低3个点，几乎不管这个空间有多大。但是如果空间小于3pt，则线将相应地降低。这个检查导致了这个代码。

ParaSpace = 2 - Rng.Paragraphs(1).SpaceBefore 
    If ParaSpace < -3 Then ParaSpace = -3 

您可能希望修改此代码以更精确地放置该行。您将看到垂直位置由选区的位置+ FondtSize + ParaSpacing组成。

以上所有代码都会创建一个参数，这些参数会被传送到另一个创建实际行的子工具。观察这些参数包括行宽，并将Activedocument设置为目标并给该行命名。可以重复给出相同的名称。 Word将使用其自己的名字，并且它们是独一无二的。这是插入该行的代码。 （您可能喜欢以使其Private）

Function SetLine(Story As Object, _ 
       Lname As String, _ 
       Lleft As Single, _ 
       Llength As Single, _ 
       Ltop As Single, _ 
       Lwidth As Single, _ 
       Lcol As Long) As Shape 
    ' 20 Aug 2016 

    Dim Fun As Shape 

    Set Fun = Story.Shapes.AddLine(Lleft, Ltop, Lleft + Llength, Ltop) 
    With Fun 
     .Title = Lname 
     .Name = Lname 
     .LockAspectRatio = msoTrue 
     With .Line 
      .Weight = Lwidth 
      .ForeColor = Lcol 
     End With 
     .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage 
     .RelativeVerticalPosition = wdRelativeVerticalPositionPage 
     .Visible = msoTrue 
     .WrapFormat.AllowOverlap = msoTrue 
     .LayoutInCell = msoFalse 
     .ZOrder msoSendBehindText 
     .LockAnchor = msoTrue 
    End With 
    Set SetLine = Fun 
End Function 

该代码包括了很多其不是可变由它接收到的参数的装置参数，诸如LockAnchor，ZOrder等你可能希望这些改变，以更好地符合你的要求。