Word VBA 查找被动语态

如何解决Word VBA 查找被动语态

我已经编写了一个程序来查找被动结构，例如'已解决'，'已写'，即以'ed'或'en'结尾的被动语态，但不是像'有成果'这样的词。为每个查找插入注释。 我快到了 - 但无法修复一些异常情况： 它适用于“已解决”。,'被解决了。和“已解决”，（其中两个空格中有 NB 空格）但不在“今天已解决”中，即在最后一个动词之后有更多单词的地方。最后一个错误是我希望修复的错误。 它还发现“正在完成”中的被动语态，即两个助动词一起，无论最后一个动词后面是否有空格。这是一个额外的好处，除了发现被指示两次的事实。 我怀疑这与我的 Is_Alpha 函数有关，它从主要动词的末尾去除标点符号。 谢谢大家，感谢您的帮助。

Sub Passives3()
Dim P_Flag As Boolean
Dim P_Cmt As Comment
Dim P_Rng As Range
Dim P_Rng2 As String
Dim P_New As String
Dim P_Fnd As Boolean
Dim Cmt As Comment
Dim P_Range As Range
Dim P_Ctr As Long
Dim Com_plete As Integer
Dim P_Word(7) As String
    P_Word(0) = "am "
    P_Word(1) = "are "
    P_Word(2) = "be "
    P_Word(3) = "been "
    P_Word(4) = "being "
    P_Word(5) = "is "
    P_Word(6) = "was "
    P_Word(7) = "were "
For P_Ctr = LBound(P_Word) To UBound(P_Word)
Set P_Rng = ActiveDocument.Range
    With P_Rng.Find
        .ClearFormatting
        .text = P_Word(P_Ctr)
        Debug.Print .text
        .MatchCase = False
        .MatchWholeWord = True
        While .Execute
            If P_Rng.Find.Found Then
                Dim P_test As Range
                Set P_test = P_Rng.Duplicate
                With P_test
                   .MoveEnd wdWord,2
                   .Select
                    P_New = P_test
                    Call Is_Alpha(P_New,P_Flag)
                    If P_Flag = False Then
                        P_New = Left(P_New,Len(P_New) - 1)
                    End If
                End With
                If (Right(Trim(P_New),2)) = "ed" _
                Or (Right(Trim(P_New),2)) = "en" Then
                    Set P_Cmt = P_Rng.Comments.Add(Range:=P_Rng,text:="Passive? " & P_New)
                    P_Cmt.Author = "Passives"
                    P_Cmt.Initial = "PSV "
                    P_Cmt.Range.Font.ColorIndex = wdGreen
                End If
            End If
        Wend
    End With
Next
End Sub

Function Is_Alpha(P_New As String,P_Flag As Boolean) As Boolean
If Asc(Right(P_New,1)) > 64 And Asc(Right(P_New,1)) < 90 Or _
       Asc(Right(P_New,1)) > 96 And Asc(Right(P_New,1)) < 123 Then
       P_Flag = True
       Else
       P_Flag = False
End If
End Function
    




    

解决方法

怎么样：

Sub Passives()
Dim i As Long,j As Long,Cmt As Comment,P_Words,X_Words
P_Words = Array("am ","are ","be ","been ","being ","is ","was ","were ")
X_Words = Array("am ","were ","has ","have ")
For i = LBound(P_Words) To UBound(P_Words)
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Text = "<" & P_Words(i) & "[! ]@e[dn]>"
      .MatchWildcards = True
    End With
    Do While .Find.Execute
      For j = LBound(X_Words) To UBound(X_Words)
        If .Words.First.Previous.Words.First.Text = X_Words(j) Then
          .Start = .Words.First.Previous.Words.First.Start
        End If
      Next
      Set Cmt = .Comments.Add(Range:=.Duplicate,Text:="Passive?")
      With Cmt
        .Author = "Passives"
        .Initial = "PSV "
        .Range.Font.ColorIndex = wdGreen
      End With
      .Collapse wdCollapseEnd
    Loop
  End With
Next
End Sub