根据字数突出显示句子

Question

我编写了 VBA 代码来迭代文档的每个句子，根据字数计数突出显示它，并记录计数。

最后，我会看到一个弹出窗口，告诉我每个字数统计桶中有多少个句子。这与我在海明威上看到的类似，但我想看到文档中句子的混合，而不是语法或任何东西。

它不是突出显示句子并以适当的标点符号结尾，而是突出显示整个背景单元格（借用 Excel 术语）。

Sub Total_Highlighter()

    Dim iCountA As Integer
    Dim iCountB As Integer
    Dim iCountC As Integer
    Dim iCountD As Integer
    Dim iCountE As Integer
    Dim iCountF As Integer

    'Saves your doc
    If Not ActiveDocument.Saved Then
        ActiveDocument.Save
    End If

    'Reset counter
    iMyCountA = 0
    iMyCountB = 0
    iMyCountC = 0
    iMyCountD = 0
    iMyCountE = 0
    iMyCountF = 0

    For Each MySent In ActiveDocument.Sentences

        If MySent.Words.Count = 0 Then
            MySent.Shading.ForegroundPatternColor = wdColorWhite
        
        ElseIf MySent.Words.Count < 6 Then
            MySent.Shading.ForegroundPatternColor = RGB(217, 151, 149)
            iMyCountA = iMyCountA + 1
        
        ElseIf MySent.Words.Count < 11 Then
            MySent.Shading.ForegroundPatternColor = RGB(250, 192, 144)
            iMyCountB = iMyCountB + 1

        ElseIf MySent.Words.Count < 16 Then
            MySent.Shading.ForegroundPatternColor = RGB(194, 214, 154)
            iMyCountC = iMyCountC + 1

        ElseIf MySent.Words.Count < 21 Then
            MySent.Shading.ForegroundPatternColor = RGB(184, 204, 228)
            iMyCountD = iMyCountD + 1

        ElseIf MySent.Words.Count < 31 Then
            MySent.Shading.ForegroundPatternColor = RGB(141, 180, 227)
            iMyCountE = iMyCountE + 1

        ElseIf MySent.Words.Count < 41 Then
            MySent.Shading.ForegroundPatternColor = RGB(178, 161, 199)
            iMyCountF = iMyCountF + 1

        End If

    Next

    MsgBox iMyCountA & " sentences shorter than or equal to 5 words." & vbCrLf & _
      iMyCountB & " sentences shorter than or equal to 10 words." & vbCrLf & _
      iMyCountC & " sentences shorter than or equal to 15 words." & vbCrLf & _
      iMyCountD & " sentences shorter than or equal to 20 words." & vbCrLf & _
      iMyCountE & " sentences shorter than or equal to 30 words." & vbCrLf & _
      iMyCountF & " sentences shorter than or equal to 40 words." & vbCrLf

End Sub

唯一有效的突出显示功能是

Shading.ForegroundPatternColor

。

我也尝试过：

Shading.BackgroundPatternColor

（产生与上面相同的结果）

Range.HighlightColorIndex

（收到 438 错误）

Replacement.Highlight

（收到 438 错误）

Answer 1

您的代码即将完成。

• 添加了从最后一句中删除段落标记的代码

• Option Explicit

  对于避免编码错误很有用。例如。

  Dim iCountA As Integer

  但

  iMyCountA = iMyCountA + 1

  中使用了不同的变量。如果您的代码中存在

  Option Explicit

  ，您将收到编译器错误。

Option Explicit
Sub demo()
    Dim iCountA As Long， iCountB As Long， iCountC As Long
    Dim iCountD As Long, iCountE As Long, iCountF As Long
    Dim iColor As Long, iCount As Long
    Dim mySent As Range
    'Saves your doc
    If Not ActiveDocument.Saved Then
        ActiveDocument.Save
    End If
    'Reset counter
    iCountA = 0
    iCountB = 0
    iCountC = 0
    iCountD = 0
    iCountE = 0
    iCountF = 0
    For Each mySent In ActiveDocument.Sentences
        ' Remove the paragraph marker from the last sentence
        If mySent.Paragraphs(1).Range.End = mySent.End Then
            mySent.End = mySent.End - 1
        End If
        iColor = 0
        iCount = mySent.Words.Count
        If iCount = 0 Then
            iColor = wdColorWhite
        ElseIf iCount < 6 Then
            iColor = RGB(217, 151, 149)
            iCountA = iCountA + 1
        ElseIf iCount < 11 Then
            iColor = RGB(250, 192, 144)
            iCountB = iCountB + 1
        ElseIf iCount < 16 Then
            iColor = RGB(194, 214, 154)
            iCountC = iCountC + 1
        ElseIf iCount < 21 Then
            iColor = RGB(184, 204, 228)
            iCountD = iCountD + 1
        ElseIf iCount < 31 Then
            iColor = RGB(141, 180, 227)
            iCountE = iCountE + 1
        ElseIf iCount < 41 Then
            iColor = RGB(178, 161, 199)
            iCountF = iCountF + 1
        End If
        If iColor > 0 Then mySent.Shading.ForegroundPatternColor = iColor
    Next
    MsgBox iCountA & " sentences shorter than or equal to 5 words." & vbCrLf & _
      iCountB & " sentences shorter than or equal to 10 words." & vbCrLf & _
      iCountC & " sentences shorter than or equal to 15 words." & vbCrLf & _
      iCountD & " sentences shorter than or equal to 20 words." & vbCrLf & _
      iCountE & " sentences shorter than or equal to 30 words." & vbCrLf & _
      iCountF & " sentences shorter than or equal to 40 words." & vbCrLf
End Sub