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等你可能希望這些改變，以更好地符合你的要求。