Microsoft单词句子长度检查器



我正在尝试实现我为 Word 找到的代码,如果句子超过 25 个单词(不等于或超过 - 刚刚超过,因此应该标记 26 个或更多单词(,它将检查句子并将它们标记为红色(。

我对这段代码遇到的问题是,如果您在句子中包含逗号,它将标记短于 25 个单词的句子 - 其他标点符号也可能发生这种情况,但到目前为止,我已经体验过它特别是逗号。

代码如下:

Sub AutoExec()
‘ The AutoExec is a special name meaning that the code will run automatically when Word starts
CustomizationContext = NormalTemplate
‘ Create key binding to change the function of the spacebar so that it calls the macro Check_Sentence
‘ each time the spacebar is pressed
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySpacebar), _
KeyCategory:=wdKeyCategoryMacro, _
Command:=”Check_Sentence”
‘ It will be useful to be able to turn the checking on and off manually
‘ so allocate ctrl-shift-spacebar to turn the checking off
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyShift, wdKeySpacebar), _
KeyCategory:=wdKeyCategoryMacro, _
Command:=”SetSpaceBarOff”
‘ and allocate ctrl-spacebar to turn the checking back on
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeySpacebar), _
KeyCategory:=wdKeyCategoryMacro, _
Command:=”SetSpaceBarOn”
End Sub
Sub SetSpaceBarOn()
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySpacebar), _
KeyCategory:=wdKeyCategoryMacro, _
Command:=”Check_Sentence”
MsgBox (“sentence length checking turned on”)
End Sub
Sub SetSpaceBarOff()
With FindKey(BuildKeyCode(wdKeySpacebar))
.Disable
End With
MsgBox (“sentence length checking turned off”)
End Sub
Sub Check_Sentence()
Dim long_sentence As Integer
‘ pressing the spacebar calls this macro so have to assume the user wanted a space to appear
‘ in the text. Therefore put a space character into the document
Selection.TypeText (” “)
‘Set number of words to be a long sentence
long_sentence = 25
For Each Test_Sentence In ActiveDocument.Sentences ‘ check each sentence in the document
If Test_Sentence.Words.Count > long_sentence Then ‘ if it longer than our limit
Test_Sentence.Font.Color = wdColorRed ‘ turn the font for the sentence red
‘ Test_Sentence.Font.Underline = wdUnderlineDotted ‘ show long sentences with a dotted underline
Else
Test_Sentence.Font.Color = wdColorBlack ‘ if less than our limit make the font black
‘ Test_Sentence.Font.Underline = wdUnderlineNone ‘ turn of the underline
End If
Next ‘ next sentence
End Sub

希望这里有人可以建议如何修改代码以避免这些问题并帮助它按照预期的方式执行!

提前感谢!

我会自己拆分句子,并计算单词数。

此函数返回True如果句子s有 25 个或更多单词

Function IsMoreThan25Words(ByVal s As String) As Boolean
Dim words() As String, i As Long, WordCount As Long
s = Replace(s, ".", " ")
s = Replace(s, ",", " ")
s = Replace(s, ":", " ")
words = Split(s, " ")
For i = LBound(words) To UBound(words)
If Len(Trim(words(i))) > 0 Then WordCount = WordCount + 1
Next
IsMoreThan25Words = WordCount >= 25
End Function

请注意,我硬编码了,.:作为分隔符,请随时更改

最新更新