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ポイントを追加しました。

Wordは前にスペースをメモします。選択には複数の段落が含まれている場合があります。私のコードは、最後の文字がメンバーである段落だけを見ています。 Wordは段落の書式にSpaceBeforeがあれば、そのスペースがどれほど大きいかにかかわらず、約3ポイント下がっているようです。しかし、スペースが3ptより小さい場合は、それに応じてラインが下がります。この検査はこのコードにつながった。

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

このコードを修正すると、より正確に行を配置できます。垂直位置は、選択+ FondtSize + ParaSpacingの位置で構成されています。

上記のコードはすべて、実際の行を作成する別のサブに供給されるパラメータを作成します。パラメータには行幅が含まれ、Activedocumentをターゲットに設定して行に名前を付けることに注意してください。同じ名前を繰り返し指定することは可能です。 Wordはadditonで独自の名前を使用しますが、それらは一意です。この行を挿入するコードは次のとおりです。あなたがより良いにこれらを変更したいと思うかもしれなど、

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を（あなたはそれをPrivateを作ることを好む場合があります）あなたの要件を満たしてください。