Question

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

要突出显示某些部分，最好遮住文本的某些部分，如下图所示：

不幸的是，我只能为整行高度添加阴影，如下图所示：

MS 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

单词着色到文本高度

1 个答案: