在VBA（word）中，如何仅在不存在注释的情况下向范围添加注释？

使用range.Find对象在Word文档中循环所有匹配项并添加注释

但是，如果一条注释已经存在，我不想再添加另一条注释，这样我就可以在同一个文档上多次运行VBA脚本

这是我的循环：

Dim all As Range
Set all = pcSetupFind(word, wdFindStop)  ' setup all.find to find 'word'
While all.Find.Execute
  If all.Find.Found Then
    If all.Comments.Count = 0 Then Call all.Comments.Add(all, comment)
  End If
Wend

但是，它总是添加注释

---

如何仅在不存在注释的情况下在某个范围内添加注释？

如果要检查注释是否已附加到文档的给定部分（一个单词、一个句子--a范围），则必须将该范围与任何/所有现有注释的范围进行比较

Option Explicit

Function CommentExistsInRange(checkRange As Range) As Boolean
    '--- compares all existing comments to the given range and
    '    checks for a match.
    '    RETURNS true if a comment exists for the given range
    Dim commentScope As Range
    Dim i As Integer
    Dim totalComments As Integer
    totalComments = ActiveDocument.Comments.Count
    CommentExistsInRange = False
    If totalComments > 0 Then
        For i = 1 To totalComments
            Set commentScope = ActiveDocument.Comments.Item(i).Scope
            If (checkRange.Start = commentScope.Start) And _
               (checkRange.End = commentScope.End) Then
                CommentExistsInRange = True
                Exit Function
            End If
        Next i
    End If
End Function

Sub FindAndComment(findText As String, searchRange As Range, newComment As String)
    Dim foundTextRange As Range
    With searchRange
        .Find.Text = findText
        .Find.Wrap = wdFindStop
        .Find.Forward = True
        While .Find.Execute
            If .Find.Found Then
                .Select
                Set foundTextRange = ActiveDocument.Range(Selection.Range.Start, _
                                                          Selection.Range.End)
                If Not CommentExistsInRange(foundTextRange) Then
                    Call ActiveDocument.Comments.Add(foundTextRange, newComment)
                End If
            End If
        Wend
    End With
End Sub

Sub Test()
    FindAndComment "Office", ActiveDocument.Range, "Around the Office watercooler"
End Sub

---

我采用了PeterT的方法，并以不同的方式实现了它

Function pcHasComments(rng As Range) As Boolean

  Dim com As comment

  For Each com In ActiveDocument.comments
    If com.scope.Start = rng.Start And com.scope.End = rng.End Then
      'MsgBox ("found comment")
      pcHasComments = True
      Exit Function
    End If
  Next

  pcHasComments = False

End Function

---

谢谢你的努力。然而，我对某一特定范围（通常是一个单词）的评论计数是多少。计算整个文档上的注释并不能解决我的问题-除非ActiveDocument没有像我认为的那样-它指的是整个文档，不是吗？是的，ActiveDocument指的是整个文档。我误解了你原来的问题。为了确定找到的文本是否附有注释，您必须将找到的文本的范围与文档中的注释列表进行比较。我已经更新了上面的代码片段来展示这一点。谢谢@philcolbourn，更高效、更简单@彼得：不客气。虽然我需要你的想法。我想如果我想要在这个范围内的评论，那么我需要一个更复杂的条件。