文字底纹精确到文字高度

Word shading exactly to text height

我目前正在处理 MS Word 报告。

要突出显示某些部分,最好对文本的某些部分进行阴影处理,如下图所示:

不幸的是,我只能为整个行高添加底纹,如下图所示:

在 MS Word 中是否有一种本机方法来完成文本高度的阴影?

否则我不得不在我的报告中嵌入图像作为标题(这是我不想要的,有几个原因,例如 Table 目录的并发症)

没有直接的方法来获得您想要的阴影,它始终是完整的行高而不是大写高度。这也是有道理的,当您考虑带有尾巴的字母(例如大写 Q 或下行字母(例如小写 g)的阴影看起来如何时)。

如果您只想将底纹添加到单行,您可以通过将矩形锚定到段落并将其放置在文本后面来模拟所需的效果。

这是一个快速而复杂的 VBA 宏,它使用形状为选定的文本行添加阴影。您必须 fine-tune 形状的高度和垂直偏移与您使用的字体和字体大小相匹配。

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