Word VBA 查找被动语态

Question

我已经编写了一个查找被动结构的程序，例如“被解决”，“被写”，即以“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
    




    

Answer 1

怎么样：

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 ", "are ", "being ", "is ", "was ", "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