完全符合文本高度的文字陰影

Question

我目前正在製作MS Word報告。

爲了突出某些部分，這將是巨大的樹蔭文本的某些部分爲圖像下方看到：

不幸的是，我只是能增加陰影的全系列高度，如圖所示如下圖：

有微軟Word中的本機的方式來完成陰影只是文本高度？

否則我被迫嵌入我的標題報告內的圖像（這是我不希望有幾個原因，如併發症目錄）

Answer 1

沒有直接的辦法有一個陰影正如你所期望的那樣，它總是達到全線高度而不是帽高。這也是有道理的，當你考慮陰影字母如何看起來像尾巴的字母（如大寫字母Q或下行字母（如小寫字母g））

如果要將陰影添加到單行只有你可以通過將一個矩形形狀錨定到段落並將其放置在文本後面來模仿期望的效果。

這是一個快速而髒的VBA宏，它將使用形狀的陰影添加到選定的文本行中。 - 將形狀的高度和垂直偏移調整爲所使用的字體和字體大小。

Sub AddShading() 
    Dim rng As Range 
    Dim startPos As Integer 
    Dim endPos As Integer 

    Dim capHeight As Single 
    capHeight = 8 

    Dim verticalOffset As Single 
    verticalOffset = 3 

    ' backup original select 
    Set rng = Selection.Range.Duplicate 

    ' start undo transaction 
    Application.UndoRecord.StartCustomRecord "Add Shading" 

    Do 
     ' select line of text 
     Selection.Collapse 
     Selection.Expand wdLine 
     If Selection.Start < rng.Start Then 
      Selection.Start = rng.Start 
     End If 
     If Selection.End > rng.End Then 
      Selection.End = rng.End 
     End If 

     ' get range of current line to be able to retrieve position of line 
     Dim rngLine As Range 
     Set rngLine = Selection.Range.Duplicate 

     ' get the left coordinate 
     Dim left As Single 
     left = rngLine.Information(wdHorizontalPositionRelativeToPage) 

     ' get the top coordinate and add a vertical adjustment depending on the font used 
     Dim top As Single 
     top = rngLine.Information(wdVerticalPositionRelativeToPage) + verticalOffset 

     ' move to the end position of the line 
     rngLine.Collapse wdCollapseEnd 
     If rngLine.Information(wdVerticalPositionRelativeToPage) > top Then 
      rngLine.Move wdCharacter, -1 
     End If 

     ' calculate width of line 
     Dim width As Integer 
     width = rngLine.Information(wdHorizontalPositionRelativeToPage) - left 

     ' add shape behind text 
     Dim shp As Shape 
     Set shp = rng.Document.Shapes _ 
      .AddShape(msoShapeRectangle, left, top, width, capHeight, rng) 

     With shp 
      ' grey shading 
      .Fill.ForeColor.RGB = RGB(192, 192, 192) 

      ' no outline 
      .Line.Visible = msoFalse 

      ' the shape should move with the text 
      .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph 

      ' position the shape behind the text 
      .WrapFormat.Type = wdWrapBehind 
     End With 

     ' continue with next line 
     Selection.Move wdLine 

    Loop While Selection.End < rng.End 

    ' restore original selection 
    rng.Select 

    Application.UndoRecord.EndCustomRecord 

End Sub