在 Word 文档中的选定文本中插入对关键字的注释的宏？

Question

我是 VBA 新手，如果遇到问题，我将不胜感激。

我有很长的 Word 文档，我需要将标准 cmets 应用于同一组关键字，但仅限于文档的选定部分。以下宏用于查找关键字并应用评论（来自此处的问题https://superuser.com/questions/547710/macro-to-insert-comment-bubbles-in-microsoft-word）：

Sub label_items()
'
' label_items Macro
'
'
Do While Selection.Find.Execute("keyword1") = True
    ActiveDocument.Comments.Add range:=Selection.range, Text:="comment for keyword 1"
Loop

End Sub

两个修改分别是：

1) 仅将 cmets 应用于用户选择的文本，而不是整个文档。我尝试了“With Selection.Range.Find”方法，但我认为不能以这种方式添加 cmets (??)

2) 对所选文本中的 20 多个关键字重复此操作。关键字不完全标准，有 P_1HAI10、P_1HAI20、P_2HAI60、P_HFS10 等名称。

编辑：我尝试合并来自类似问题的代码（Word VBA: finding a set of words and inserting predefined comments 和 Word macro, storing the current selection (VBA)），但我当前的尝试（如下）仅针对第一个关键字和评论运行，并运行在整个文档上，而不仅仅是我的文本已突出显示/选择。

Sub label_items()
'
' label_items Macro
'
Dim selbkup As range
Set selbkup = ActiveDocument.range(Selection.range.Start, Selection.range.End)

Set range = selbkup

Do While range.Find.Execute("keyword 1") = True
    ActiveDocument.Comments.Add range, "comment for keyword 1"
Loop

Set range = selbkup

Do While range.Find.Execute("keyword 2") = True
    ActiveDocument.Comments.Add range, "comment for keyword 2"
Loop

'I would repeat this process for all of my keywords

End Sub

我已经梳理了以前的问题和 Office 开发中心，但我被困住了。非常感谢任何帮助/指导！

Answer 1

这是一个添加循环和Finding 的方法@ 您正在寻找的下一个关键字的问题。下面的代码示例中有一些建议，因此请根据需要进行调整。

Option Explicit

Sub label_items()
    Dim myDoc As Document
    Dim targetRange As Range
    Set myDoc = ActiveDocument
    Set targetRange = Selection.Range

    '--- drop a bookmark to return the cursor to it's original location
    Const RETURN_BM = "OrigCursorLoc"
    myDoc.Bookmarks.Add Name:=RETURN_BM, Range:=Selection.Range

    '--- if nothing is selected, then search the whole document
    If Selection.Start = Selection.End Then
        Selection.Start = 0
        targetRange.Start = 0
        targetRange.End = myDoc.Range.End
    End If

    '--- build list of keywords to search
    Dim keywords() As String
    keywords = Split("SMS,HTTP,SMTP", ",", , vbTextCompare)

    '--- search for all keywords within the user selected range
    Dim i As Long
    For i = 0 To UBound(keywords)
        '--- set the cursor back to the beginning of the
        '    originally selected range
        Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
        Do
            With Selection.Find
                .Forward = True
                .Wrap = wdFindStop
                .Text = keywords(i)
                .Execute

                If .Found Then
                    If (Selection.Start < targetRange.End) Then
                        Selection.Comments.Add Selection.Range, _
                                               Text:="Found the " & keywords(i) & " keyword"
                    Else
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            End With
        Loop
    Next i

    '--- set the cursor back to the beginning of the
    '    originally selected range
    Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM

End Sub